unit Xdom_3_2;

// XDOM 3.2.4
// Extended Document Object Model 3.2.4
// Delphi 5/6/7/8/2005/2006 and Kylix Implementation
// December 2006
//
//
// LICENSE
//
// The contents of this file are subject to the Mozilla Public License Version
// 1.1 (the "License"); you may not use this file except in compliance with
// the License. You may obtain a copy of the License at
// "http://www.mozilla.org/MPL/"
//
// Software distributed under the License is distributed on an "AS IS" basis,
// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
// the specific language governing rights and limitations under the License.
//
// The Original Code is "Xdom_3_2.pas".
//
// The Initial Developer of the Original Code is Dieter Kцhler (Heidelberg,
// Germany, "http://www.philo.de/"). Portions created by the Initial Developer
// are Copyright (C) 1999-2007 Dieter Kцhler. All Rights Reserved.
//
// Modified by Sergey Ostanin.
//
// Alternatively, the contents of this file may be used under the terms of the
// GNU General Public License Version 2 or later (the "GPL"), in which case the
// provisions of the GPL are applicable instead of those above. If you wish to
// allow use of your version of this file only under the terms of the GPL, and
// not to allow others to use your version of this file under the terms of the
// MPL, indicate your decision by deleting the provisions above and replace them
// with the notice and other provisions required by the GPL. If you do not delete
// the provisions above, a recipient may use your version of this file under the
// terms of any one of the MPL or the GPL.

{$WARNINGS OFF}

{$IFDEF WIN32}
  {$IFNDEF VER140}
    {$DEFINE MSWINDOWS}
  {$ENDIF}
{$ENDIF}
{$IFDEF WIN16}
  {$DEFINE MSWINDOWS}
{$ENDIF}
{$IFDEF VER140}
  {$DEFINE VER140+}
{$ENDIF}
{$IFDEF VER150}
  {$DEFINE VER140+}
{$ENDIF}
{$IFDEF VER160}
  {$DEFINE VER140+}
{$ENDIF}
{$IFDEF VER170}
  {$DEFINE VER140+}
{$ENDIF}
{$IFDEF VER180}
  {$DEFINE VER140+}
{$ENDIF}

interface

uses 
  cUnicodeCodecsWin32, ParserUtilsWin32, TreeUtils, WideStringUtils, 
    // The above units are contained in the Open XML Utilities package 1.x
    // available at "http://www.philo.de/xml/".
  {$IFDEF MSWINDOWS}
    {$IFDEF VER140+} Types,
    {$ELSE} Windows, {$ENDIF}
  {$ENDIF}
  {$IFDEF LINUX}
    Types,
  {$ENDIF}
  Contnrs, SysUtils, Classes;

type
  EDomException = class(Exception);

  EIndex_Size_Err = class(EdomException);
  EHierarchy_Request_Err = class(EdomException);
  EWrong_Document_Err = class(EdomException);
  EInvalid_Character_Err = class(EdomException);
  ENo_Data_Allowed_Err = class(EdomException);
  ENo_Modification_Allowed_Err = class(EdomException);
  ENot_Found_Err = class(EdomException);
  ENot_Supported_Err = class(EdomException);
  EInuse_Err = class(EdomException);
  EInvalid_State_Err = class(EdomException);
  ESyntax_Err = class(EdomException);
  EInvalid_Modification_Err = class(EdomException);
  ENamespace_Err = class(EdomException);
  EWrong_DOM_Implementation_Err = class(EdomException);

  EParserException = class(EdomException);

  EXPath_Exception = class(EdomException);
  EXPath_Invalid_Expression_Err = class(EXPath_Exception);
  EXPath_Invalid_Function_Call_Err = class(EXPath_Exception);
  EXPath_Type_Err = class(EXPath_Exception);


  TXmlErrorType = (

    // Remark: The order and number of this error types is likely subject to
    //         change in future XDOM versions.  Therefore, you are strongly
    //         adviced to refer to error types by using the constants below,
    //         but avoid using their numerical equivalents!

    ET_NONE, // No error

    ET_DOCTYPE_NOT_FOUND,
    ET_DOUBLE_ATTLISTDECL,
    ET_DOUBLE_ATTDEF,
    ET_DOUBLE_ENTITY_DECL,
    ET_DOUBLE_PARAMETER_ENTITY_DECL,

    ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH,
    ET_ATTRIBUTE_TYPE_MISMATCH,
    ET_DUPLICATE_ELEMENT_TYPE_DECL,
    ET_DUPLICATE_ENUMERATION_TOKEN,
    ET_DUPLICATE_ID_ON_ELEMENT_TYPE,
    ET_DUPLICATE_ID_VALUE,
    ET_DUPLICATE_NAME_IN_MIXED_CONTENT,
    ET_DUPLICATE_NOTATION_DECL,
    ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE,
    ET_DUPLICATE_NOTATION_TOKEN,
    ET_DUPLICATE_TOKENS,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_CDATA_SECTION_WHERE_ELEMENT_ONLY,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_CHILD_ELEMENT_TYPE,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_ELEMENT_WHERE_PCDATA_ONLY,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_PCDATA_WHERE_ELEMENT_ONLY,
    ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT,
    ET_ENTITY_REFERENCED_BEFORE_DECLARED_VC,
    ET_FIXED_ATTRIBUTE_MISMATCH,
    ET_ID_NEITHER_IMPLIED_NOR_REQUIRED,
    ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL,
    ET_NOTATION_ON_EMPTY_ELEMENT,
    ET_PE_NOT_PROPERLY_NESTED_WITH_CONDITIONAL_SECTION,
    ET_PE_NOT_PROPERLY_NESTED_WITH_DECL,
    ET_PE_NOT_PROPERLY_NESTED_WITH_PARENTHESIZED_GROUP,
    ET_PREDEFINED_ENTITY_INCORRECTLY_REDECLARED,
    ET_REQUIRED_ATTRIBUTE_NOT_SPECIFIED,
    ET_TARGET_ID_VALUE_NOT_FOUND,
    ET_UNDEFINED_ATTRIBUTE,
    ET_UNDEFINED_ELEMENT_TYPE,
    ET_UNDEFINED_ENTITY_VC,
    ET_UNDEFINED_NOTATION,
    ET_UNDEFINED_PARAMETER_ENTITY,
    ET_UNDEFINED_TARGET_UNPARSED_ENTITY,
    ET_UNNORMALIZED_EXT_ATTR_IN_STANDALONE_DOC,
    ET_UNRESOLVABLE_EXTERNAL_SUBSET,
    ET_UNSPECIFIED_EXT_ATTR_IN_STANDALONE_DOC,
    ET_WHITESPACE_IN_EXT_ELEMENT_CONTENT_IN_STANDALONE_DOC,
    ET_WRONG_ROOT_ELEMENT_TYPE,

    ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY,
    ET_BYTE_ORDER_MARK_ENCODING_MISMATCH,
    ET_CDATA_START_EXPECTED,
    ET_COMMENT_START_EXPECTED,
    ET_DOCTYPE_START_EXPECTED,
    ET_DOUBLE_ATTRIBUTE_NAME,
    ET_DOUBLE_EQUALITY_SIGN,
    ET_DOUBLE_HYPHEN_IN_COMMENT,
    ET_DOUBLE_ROOT_ELEMENT,
    ET_ENTITY_REFERENCED_BEFORE_DECLARED_WFC,
    ET_EXT_DECL_ENTITY_REFERENCED_IN_STANDALONE_DOC,
    ET_HYPHEN_AT_COMMENT_END,
    ET_INVALID_ATTRIBUTE_NAME,
    ET_INVALID_ATTRIBUTE_VALUE,
    ET_INVALID_CDATA_SECTION,
    ET_INVALID_CHARACTER,
    ET_INVALID_CHAR_REF,
    ET_INVALID_COMMENT,
    ET_INVALID_ELEMENT_NAME,
    ET_INVALID_ENCODING_NAME,
    ET_INVALID_ENTITY_NAME,
    ET_INVALID_PARAMETER_ENTITY_NAME,
    ET_INVALID_PROCESSING_INSTRUCTION,
    ET_INVALID_PUBID_LITERAL,
    ET_INVALID_SYSTEM_LITERAL,
    ET_INVALID_TEXT_DECL,
    ET_INVALID_VERSION_NUMBER,
    ET_INVALID_XML_DECL,
    ET_LEFT_SQUARE_BRACKET_EXPECTED,
    ET_LT_IN_ATTRIBUTE_VALUE,
    ET_MISSING_ELEMENT_NAME,
    ET_MISSING_END_TAG,
    ET_MISSING_ENTITY_NAME,
    ET_MISSING_EQUALITY_SIGN,
    ET_MISSING_QUOTATION_MARK,
    ET_MISSING_START_TAG,
    ET_MISSING_WHITE_SPACE,
    ET_NOT_IN_ROOT_ELEMENT,
    ET_NO_PROPER_MARKUP_REFERENCED,
    ET_PE_BETWEEN_DECLARATIONS,
    ET_PUBLIC_KEYWORD_EXPECTED,
    ET_QUOTATION_MARK_EXPECTED,
    ET_RECURSIVE_REFERENCE,
    ET_REFERS_TO_UNPARSED_ENTITY,
    ET_RIGHT_SQUARE_BRACKET_EXPECTED,
    ET_ROOT_ELEMENT_NOT_FOUND,
    ET_SYSTEM_KEYWORD_EXPECTED,
    ET_UNCLOSED_CDATA_SECTION,
    ET_UNCLOSED_CHAR_REF,
    ET_UNCLOSED_COMMENT,
    ET_UNCLOSED_DOCTYPE,
    ET_UNCLOSED_ELEMENT,
    ET_UNCLOSED_ENTITY_REF,
    ET_UNCLOSED_PROCESSING_INSTRUCTION,
    ET_UNDEFINED_ENTITY_WFC,
    ET_WRONG_ORDER,

    ET_ATTLIST_DECL_START_EXPECTED,
    ET_CONDITIONAL_SECTION_NOT_ALLOWED,
    ET_DOUBLE_DOCTYPE,
    ET_ELEMENT_DECL_START_EXPECTED,
    ET_ENTITY_DECL_START_EXPECTED,
    ET_INVALID_ATTLIST_DECL_NAME,
    ET_INVALID_ATTRIBUTE_DECL,
    ET_INVALID_ATTRIBUTE_NAME_IN_ATTRIBUTE_DECL,
    ET_INVALID_CONDITIONAL_SECTION,
    ET_INVALID_CONTENT_MODEL_TOKEN_IN_ELEMENT_DECL,
    ET_INVALID_ELEMENT_DECL,
    ET_INVALID_ELEMENT_NAME_IN_ATTRIBUTE_DECL,
    ET_INVALID_ELEMENT_NAME_IN_ELEMENT_DECL,
    ET_INVALID_ENTITY_DECL,
    ET_INVALID_ENTITY_NAME_IN_ENTITY_DECL,
    ET_INVALID_ENTITY_NAME_IN_PARAMETER_ENTITY_DECL,
    ET_INVALID_ENTITY_VALUE_IN_ENTITY_DECL,
    ET_INVALID_ENTITY_VALUE_IN_PARAMETER_ENTITY_DECL,
    ET_INVALID_ENUMERATION_TOKEN_IN_ATTRIBUTE_DECL,
    ET_INVALID_MARKUP_DECL,
    ET_INVALID_NOTATION_DECL,
    ET_INVALID_NOTATION_NAME_IN_ENTITY_DECL,
    ET_INVALID_NOTATION_NAME_IN_NOTATION_DECL,
    ET_INVALID_NOTATION_TOKEN_IN_ATTRIBUTE_DECL,
    ET_INVALID_PARAMETER_ENTITY_DECL,
    ET_INVALID_ROOT_ELEMENT_NAME_IN_DOCTYPE_DECL,
    ET_KEYWORD_ANY_NOT_ALLOWED,
    ET_KEYWORD_EMPTY_NOT_ALLOWED,
    ET_KEYWORD_PCDATA_NOT_ALLOWED,
    ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL,
    ET_MISSING_ENTITY_VALUE_IN_ENTITY_DECL,
    ET_MISSING_ENTITY_VALUE_IN_PARAMETER_ENTITY_DECL,
    ET_NOTATION_DECL_START_EXPECTED,
    ET_PARAMETER_ENTITY_REF_NOT_ALLOWED,
    ET_UNCLOSED_ATTLIST_DECL,
    ET_UNCLOSED_CONDITIONAL_SECTION,
    ET_UNCLOSED_ELEMENT_DECL,
    ET_UNCLOSED_ENTITY_DECL,
    ET_UNCLOSED_NOTATION_DECL,
    ET_UNCLOSED_PARAMETER_ENTITY_REF,
    ET_UNKNOWN_DECL_TYPE,
    ET_WHITESPACE_EXPECTED,

    ET_INVALID_NAMESPACE_URI,
    ET_INVALID_PREFIX,
    ET_INVALID_QUALIFIED_NAME,
    ET_NAMESPACE_URI_NOT_FOUND,
    ET_WRONG_PREFIX_MAPPING_NESTING,

    ET_ENCODING_NOT_SUPPORTED,
    ET_EXT_ENTITY_RESOURCE_NOT_FOUND,
    ET_EXT_PARAMETER_ENTITY_RESOURCE_NOT_FOUND,
    ET_INVALID_CHARACTER_IN_EXT_ENTITY,
    ET_XML_VERSION_NOT_SUPPORTED
  );

  TXmlErrorTypes = set of TXmlErrorType;

const
  ET_WARNINGS: TXmlErrorTypes = [
    ET_NONE, // Included in ET_WARNINGS to ease calculations.
    ET_DOCTYPE_NOT_FOUND,
    ET_DOUBLE_ATTLISTDECL,
    ET_DOUBLE_ATTDEF,
    ET_DOUBLE_ENTITY_DECL,
    ET_DOUBLE_PARAMETER_ENTITY_DECL
  ];

  ET_ERRORS: TXmlErrorTypes = [
    ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH,
    ET_ATTRIBUTE_TYPE_MISMATCH,
    ET_DUPLICATE_ELEMENT_TYPE_DECL,
    ET_DUPLICATE_ENUMERATION_TOKEN,
    ET_DUPLICATE_ID_ON_ELEMENT_TYPE,
    ET_DUPLICATE_ID_VALUE,
    ET_DUPLICATE_NAME_IN_MIXED_CONTENT,
    ET_DUPLICATE_NOTATION_DECL,
    ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE,
    ET_DUPLICATE_NOTATION_TOKEN,
    ET_DUPLICATE_TOKENS,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_CDATA_SECTION_WHERE_ELEMENT_ONLY,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_CHILD_ELEMENT_TYPE,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_ELEMENT_WHERE_PCDATA_ONLY,
    ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_PCDATA_WHERE_ELEMENT_ONLY,
    ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT,
    ET_ENTITY_REFERENCED_BEFORE_DECLARED_VC,
    ET_FIXED_ATTRIBUTE_MISMATCH,
    ET_ID_NEITHER_IMPLIED_NOR_REQUIRED,
    ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL,
    ET_NOTATION_ON_EMPTY_ELEMENT,
    ET_PE_NOT_PROPERLY_NESTED_WITH_CONDITIONAL_SECTION,
    ET_PE_NOT_PROPERLY_NESTED_WITH_DECL,
    ET_PE_NOT_PROPERLY_NESTED_WITH_PARENTHESIZED_GROUP,
    ET_PREDEFINED_ENTITY_INCORRECTLY_REDECLARED,
    ET_REQUIRED_ATTRIBUTE_NOT_SPECIFIED,
    ET_TARGET_ID_VALUE_NOT_FOUND,
    ET_UNDEFINED_ATTRIBUTE,
    ET_UNDEFINED_ELEMENT_TYPE,
    ET_UNDEFINED_ENTITY_VC,
    ET_UNDEFINED_NOTATION,
    ET_UNDEFINED_PARAMETER_ENTITY,
    ET_UNDEFINED_TARGET_UNPARSED_ENTITY,
    ET_UNNORMALIZED_EXT_ATTR_IN_STANDALONE_DOC,
    ET_UNRESOLVABLE_EXTERNAL_SUBSET,
    ET_UNSPECIFIED_EXT_ATTR_IN_STANDALONE_DOC,
    ET_WHITESPACE_IN_EXT_ELEMENT_CONTENT_IN_STANDALONE_DOC,
    ET_WRONG_ROOT_ELEMENT_TYPE
  ];

  ET_FATAL_ERRORS: TXmlErrorTypes = [
    ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY,
    ET_BYTE_ORDER_MARK_ENCODING_MISMATCH,
    ET_CDATA_START_EXPECTED,
    ET_COMMENT_START_EXPECTED,
    ET_DOCTYPE_START_EXPECTED,
    ET_DOUBLE_ATTRIBUTE_NAME,
    ET_DOUBLE_EQUALITY_SIGN,
    ET_DOUBLE_HYPHEN_IN_COMMENT,
    ET_DOUBLE_ROOT_ELEMENT,
    ET_ENTITY_REFERENCED_BEFORE_DECLARED_WFC,
    ET_EXT_DECL_ENTITY_REFERENCED_IN_STANDALONE_DOC,
    ET_HYPHEN_AT_COMMENT_END,
    ET_INVALID_ATTRIBUTE_NAME,
    ET_INVALID_ATTRIBUTE_VALUE,
    ET_INVALID_CDATA_SECTION,
    ET_INVALID_CHARACTER,
    ET_INVALID_CHAR_REF,
    ET_INVALID_COMMENT,
    ET_INVALID_ELEMENT_NAME,
    ET_INVALID_ENCODING_NAME,
    ET_INVALID_ENTITY_NAME,
    ET_INVALID_PARAMETER_ENTITY_NAME,
    ET_INVALID_PROCESSING_INSTRUCTION,
    ET_INVALID_PUBID_LITERAL,
    ET_INVALID_SYSTEM_LITERAL,
    ET_INVALID_TEXT_DECL,
    ET_INVALID_VERSION_NUMBER,
    ET_INVALID_XML_DECL,
    ET_LEFT_SQUARE_BRACKET_EXPECTED,
    ET_LT_IN_ATTRIBUTE_VALUE,
    ET_MISSING_ELEMENT_NAME,
    ET_MISSING_END_TAG,
    ET_MISSING_ENTITY_NAME,
    ET_MISSING_EQUALITY_SIGN,
    ET_MISSING_QUOTATION_MARK,
    ET_MISSING_START_TAG,
    ET_MISSING_WHITE_SPACE,
    ET_NOT_IN_ROOT_ELEMENT,
    ET_NO_PROPER_MARKUP_REFERENCED,
    ET_PE_BETWEEN_DECLARATIONS,
    ET_PUBLIC_KEYWORD_EXPECTED,
    ET_QUOTATION_MARK_EXPECTED,
    ET_RECURSIVE_REFERENCE,
    ET_REFERS_TO_UNPARSED_ENTITY,
    ET_ROOT_ELEMENT_NOT_FOUND,
    ET_SYSTEM_KEYWORD_EXPECTED,
    ET_UNCLOSED_CDATA_SECTION,
    ET_UNCLOSED_CHAR_REF,
    ET_UNCLOSED_COMMENT,
    ET_UNCLOSED_DOCTYPE,
    ET_UNCLOSED_ELEMENT,
    ET_UNCLOSED_ENTITY_REF,
    ET_UNCLOSED_PROCESSING_INSTRUCTION,
    ET_UNDEFINED_ENTITY_WFC,
    ET_WRONG_ORDER,

    ET_ATTLIST_DECL_START_EXPECTED,
    ET_CONDITIONAL_SECTION_NOT_ALLOWED,
    ET_DOUBLE_DOCTYPE,
    ET_ELEMENT_DECL_START_EXPECTED,
    ET_ENTITY_DECL_START_EXPECTED,
    ET_INVALID_ATTLIST_DECL_NAME,
    ET_INVALID_ATTRIBUTE_DECL,
    ET_INVALID_ATTRIBUTE_NAME_IN_ATTRIBUTE_DECL,
    ET_INVALID_CONDITIONAL_SECTION,
    ET_INVALID_ELEMENT_DECL,
    ET_INVALID_ELEMENT_NAME_IN_ATTRIBUTE_DECL,
    ET_INVALID_ELEMENT_NAME_IN_ELEMENT_DECL,
    ET_INVALID_ENTITY_DECL,
    ET_INVALID_ENTITY_NAME_IN_ENTITY_DECL,
    ET_INVALID_ENTITY_NAME_IN_PARAMETER_ENTITY_DECL,
    ET_INVALID_ENTITY_VALUE_IN_ENTITY_DECL,
    ET_INVALID_ENTITY_VALUE_IN_PARAMETER_ENTITY_DECL,
    ET_INVALID_ENUMERATION_TOKEN_IN_ATTRIBUTE_DECL,
    ET_INVALID_MARKUP_DECL,
    ET_INVALID_NOTATION_DECL,
    ET_INVALID_NOTATION_NAME_IN_ENTITY_DECL,
    ET_INVALID_NOTATION_NAME_IN_NOTATION_DECL,
    ET_INVALID_NOTATION_TOKEN_IN_ATTRIBUTE_DECL,
    ET_INVALID_PARAMETER_ENTITY_DECL,
    ET_INVALID_ROOT_ELEMENT_NAME_IN_DOCTYPE_DECL,
    ET_KEYWORD_ANY_NOT_ALLOWED,
    ET_KEYWORD_EMPTY_NOT_ALLOWED,
    ET_KEYWORD_PCDATA_NOT_ALLOWED,
    ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL,
    ET_MISSING_ENTITY_VALUE_IN_ENTITY_DECL,
    ET_MISSING_ENTITY_VALUE_IN_PARAMETER_ENTITY_DECL,
    ET_NOTATION_DECL_START_EXPECTED,
    ET_PARAMETER_ENTITY_REF_NOT_ALLOWED,
    ET_UNCLOSED_ATTLIST_DECL,
    ET_UNCLOSED_CONDITIONAL_SECTION,
    ET_UNCLOSED_ELEMENT_DECL,
    ET_UNCLOSED_ENTITY_DECL,
    ET_UNCLOSED_NOTATION_DECL,
    ET_UNCLOSED_PARAMETER_ENTITY_REF,
    ET_UNKNOWN_DECL_TYPE,
    ET_WHITESPACE_EXPECTED,

    ET_INVALID_NAMESPACE_URI,
    ET_INVALID_PREFIX,
    ET_INVALID_QUALIFIED_NAME,
    ET_NAMESPACE_URI_NOT_FOUND,
    ET_WRONG_PREFIX_MAPPING_NESTING,

    ET_ENCODING_NOT_SUPPORTED,
    ET_EXT_ENTITY_RESOURCE_NOT_FOUND,
    ET_EXT_PARAMETER_ENTITY_RESOURCE_NOT_FOUND,
    ET_INVALID_CHARACTER_IN_EXT_ENTITY,
    ET_XML_VERSION_NOT_SUPPORTED
  ];

  ET_NAMESPACE_FATAL_ERRORS: TXmlErrorTypes = [
    ET_INVALID_NAMESPACE_URI,
    ET_INVALID_PREFIX,
    ET_INVALID_QUALIFIED_NAME,
    ET_NAMESPACE_URI_NOT_FOUND,
    ET_WRONG_PREFIX_MAPPING_NESTING
  ];

type
  TDomTrinarean = ( T_UNKNOWN,
                    T_TRUE,
                    T_FALSE );

type
  TDomNodeType = ( ntUnknown,
                   ntElement_Node,
                   ntAttribute_Node,
                   ntText_Node,
                   ntCDATA_Section_Node,
                   ntEntity_Reference_Node,
                   ntProcessing_Instruction_Node,
                   ntComment_Node,
                   ntDocument_Node,
                   ntDocument_Fragment_Node,
                   ntDocument_Type_Decl_Node,
                   ntXPath_Namespace_Node );

  TDomWhatToShow = set of TDomNodeType;

const
  SHOW_ALL: TDomWhatToShow = [ ntElement_Node .. High(TDomNodeType) ];
  AS_UNBOUNDED = High(Integer);

type
  TDomXPathResultType = ( XPATH_BOOLEAN_TYPE,
                          XPATH_NODE_SET_TYPE,
                          XPATH_NUMBER_TYPE,
                          XPATH_STRING_TYPE );

  TDomXPathResultTypes = set of TDomXPathResultType;

const
  XPATH_ANY_TYPE: TDomXPathResultTypes = [XPATH_BOOLEAN_TYPE .. High(TDomXPathResultType)];

type
  TXmlDataType = (AS_STRING_DATATYPE,
                  AS_NOTATION_DATATYPE,
                  AS_ID_DATATYPE,
                  AS_IDREF_DATATYPE,
                  AS_IDREFS_DATATYPE,
                  AS_ENTITY_DATATYPE,
                  AS_ENTITIES_DATATYPE,
                  AS_NMTOKEN_DATATYPE,
                  AS_NMTOKENS_DATATYPE,
                  AS_BOOLEAN_DATATYPE,
                  AS_FLOAT_DATATYPE,
                  AS_DOUBLE_DATATYPE,
                  AS_DECIMAL_DATATYPE,
                  AS_HEXBINARY_DATATYPE,
                  AS_BASE64BINARY_DATATYPE,
                  AS_ANYURI_DATATYPE,
                  AS_QNAME_DATATYPE,
                  AS_DURATION_DATATYPE,
                  AS_DATETIME_DATATYPE,
                  AS_DATE_DATATYPE,
                  AS_TIME_DATATYPE,
                  AS_GYEARMONTH_DATATYPE,
                  AS_GYEAR_DATATYPE,
                  AS_GMONTHDAY_DATATYPE,
                  AS_GDAY_DATATYPE,
                  AS_GMONTH_DATATYPE,
                  AS_INTEGER_DATATYPE,
                  AS_NAME_DATATYPE,
                  AS_NCNAME_DATATYPE,
                  AS_NORMALIZEDSTRING_DATATYPE,
                  AS_TOKEN_DATATYPE,
                  AS_LANGUAGE_DATATYPE,
                  AS_NONPOSITIVEINTEGER_DATATYPE,
                  AS_NEGATIVEINTEGER_DATATYPE,
                  AS_LONG_DATATYPE,
                  AS_INT_DATATYPE,
                  AS_SHORT_DATATYPE,
                  AS_BYTE_DATATYPE,
                  AS_NONNEGATIVEINTEGER_DATATYPE,
                  AS_UNSIGNEDLONG_DATATYPE,
                  AS_UNSIGNEDINT_DATATYPE,
                  AS_UNSIGNEDSHORT_DATATYPE,
                  AS_UNSIGNEDBYTE_DATATYPE,
                  AS_POSITIVEINTEGER_DATATYPE,
                  AS_ANYSIMPLETYPE_DATATYPE,
                  AS_ANYTYPE_DATATYPE
                  );

  TDomAttrValueConstraint = (AVC_DEFAULT,
                             AVC_FIXED,
                             AVC_IMPLIED,
                             AVC_REQUIRED);

  TDtdContentModelType = ( DTD_CHOICE_CM,
                           DTD_ELEMENT_CM,
                           DTD_SEQUENCE_CM);

  TDtdContentType = (DTD_ANY_CONTENTTYPE,
                     DTD_EMPTY_CONTENTTYPE,
                     DTD_ELEMENT_CONTENTTYPE,
                     DTD_MIXED_CONTENTTYPE,
                     DTD_STRICT_MIXED_CONTENTTYPE);

  TDtdEntityType = (DTD_INTERNAL_ENTITY,
                    DTD_EXTERNAL_ENTITY,
                    DTD_PREDEFINED_ENTITY);

  TDtdOrigin = (DTD_INTERNALLY_DECLARED,
                DTD_EXTERNALLY_DECLARED,
                DTD_PREDEFINED);

  TDtdFrequency = (DTD_REQUIRED_FRQ,
                   DTD_OPTIONAL_FRQ,
                   DTD_ONE_OR_MORE_FRQ,
                   DTD_ZERO_OR_MORE_FRQ);

  TDtdObjectType = (DTD_UNDEFINED,
                    DTD_ATTLIST_DECLARATION,
                    DTD_ATTRIBUTE_DECLARATION,
                    DTD_CONTENT_MODEL,
                    DTD_ELEMENT_DECLARATION,
                    DTD_ENTITY_DECLARATION,
                    DTD_NOTATION_DECLARATION);

  TDtdObjectTypeSet = set of TDtdObjectType;

  TDomPieceType = ( xmlProcessingInstruction,
                    xmlComment,
                    xmlCDATA,
                    xmlPCDATA,
                    xmlDoctype,
                    xmlStartTag,
                    xmlEndTag,
                    xmlEmptyElementTag,
                    xmlCharRef,
                    xmlEntityRef,
                    xmlAttribute,
                    xmlParameterEntityRef,
                    xmlEntityDecl,
                    xmlElementDecl,
                    xmlAttributeDecl,
                    xmlNotationDecl,
                    xmlCondSection,
                    xmlParameterEntityDecl,
                    xmlXmlDeclaration,
                    xmlTextDeclaration,
                    xmlUnknown );

  TDomDocumentPosition = set of ( Document_Position_Contained_By,
                                  Document_Position_Contains,
                                  Document_Position_Disconnected,
                                  Document_Position_Equivalent,
                                  Document_Position_Following,
                                  Document_Position_Preceding,
                                  Document_Position_Same_Node );

  TDomEntityResolveOption = (erReplace, erExpand);

  TDomEntityType = (etExternal_Entity, etInternal_Entity);

  TDomFilterResult = (filter_accept, filter_reject, filter_skip);

  TDomFilenameToUriOptions = set of (fuSetLocalhost, fuPlainColon);

  TDomNodeEvent = (neClearing, neRemoving);

  TDomPosition = (posBefore, posAfter);

  TDomStandalone = ( STANDALONE_YES,
                     STANDALONE_NO,
                     STANDALONE_UNSPECIFIED );

  TDomNode               = class;
  TDomAttr               = class;
  TDomElement            = class;
  TDomCustomDocument     = class;
  TDomDocument           = class;
  TDomDocumentNS         = class;
  TDomNodeList           = class;

  TDomAbstractView       = class;

  TDomMediaList          = class;

  TXmlSourceCodePiece    = class;

  TXmlStreamBuilder      = class;
  TXmlDtdModelBuilder    = class;

  TDomXPathSyntaxNode    = class;
  TXPathExpression       = class;
  TDomXPathCustomResult  = class;
  TDomXPathNodeSetResult = class;

  IDomLocator = interface;

  TDomOperationType = ( OT_NODE_ADOPTED,
                        OT_NODE_CLONED,
                        OT_NODE_DESTROYED,
                        OT_NODE_IMPORTED,
                        OT_NODE_RENAMED );

  TDomAttrChange = ( AC_ADDITION,
                     AC_MODIFICATION,
                     AC_REMOVAL );

  TDomXmlnsDeclType = ( NSDT_DEFAULT,
                        NSDT_PREFIXED,
                        NSDT_NONE );

  TDomPreparationStatus = ( PS_UNPREPARED,
                            PS_INCOMPLETE,
                            PS_INCOMPLETE_STANDALONE,
                            PS_INCOMPLETE_NOT_STANDALONE,
                            PS_INCOMPLETE_ABORTED,
                            PS_INT_SUBSET_COMPLETED,
                            PS_COMPLETED,
                            PS_INEXISTANT );

  TDomDocTypeDeclTreatment = ( dtIgnore,
                               dtCheckWellformedness,
                               dtCheckValidity );

  TDomUserDataEvent = procedure(const Operation: TDomOperationType;
                                const Key: WideString;
                                const Data: TObject;
                                const Src,
                                      Dst: TDomNode) of object;

  TDomAttrModifiedEvent = procedure(Sender: TObject;
                                    ModifiedNode: TDomNode;
                                    AttrChange: TDomAttrChange;
                                    RelatedAttr: TDomAttr) of object;

  TDomNotifyNodeEvent = procedure(Sender: TObject;
                                  Node: TDomNode) of object;

  TDomLocationEvent = procedure(Sender: TObject;
                                const Locator: IDomLocator) of object;

  TDomResolveResourceEvent = procedure(      Sender: TObject;
                                       const ResourceType,
                                             NamespaceURI: WideString;
                                         var PublicId,
                                             SystemId: WideString;
                                         var Stream: TStream;
                                         var CertifiedText: Boolean) of object;

  TDomResolveEntityProc = procedure(const Origin: TDtdOrigin;
                                    const BaseURI,
                                          PubId,
                                          SysId: WideString;
                                      out ReplacementText: WideString;
                                      out Error: TXmlErrorType) of object;

  TDomResolveEntityEvent = procedure(      Sender: TObject;
                                     const EntityName: WideString;
                                       var EntityValue,
                                           PubId,
                                           SysId: WideString;
                                       var Error: TXmlErrorType) of object;

  TDomSerializationEvent = procedure(Sender: TXmlStreamBuilder;
                                     PieceType: TDomPieceType;
                                     const Locator: IDomLocator) of object;

  TDomWideStringLocationEvent = procedure(Sender: TObject;
                                          const S: WideString;
                                          const Locator: IDomLocator) of object;

  TDomError = class;

  TDomErrorEvent = procedure(    Sender: TObject;
                                 Error: TDomError;
                             var Go: Boolean) of object;

  TDomErrorNotifyEvent = procedure(Sender: TObject;
                                   Error: TDomError) of object;

  TDomRequestXPathFunctionResultEvent = procedure(const NamespaceURI,
                                                        LocalName: WideString;
                                                  const ContextNode: TDomNode;
                                                  const ContextPosition: Integer;
                                                  const ContextSize: Integer;
                                                  const Arguments: TList;
                                                    var Value: TDomXPathCustomResult) of object;

  TDomRequestXPathVariableEvent = procedure(const Sender: TXPathExpression;
                                            const NamespaceURI,
                                                  LocalName: WideString;
                                              var Value: TDomXPathCustomResult) of object;

  TDomXPathLookupNamespaceURIEvent = procedure(const Sender: TXPathExpression;
                                               const APrefix: WideString;
                                                 var ANamespaceURI: WideString) of object;

  TDtdModel               = class;
  TDtdValidationAgent     = class;
  TDtdObject              = class;
  TDtdAttributeDecl       = class;
  TDtdElementDecl         = class;
  TDtdEntityDecl          = class;
  TDtdNotationDecl        = class;

  TCustomResourceResolver = class;

  TUtilsNoRefCount = class(TObject, IUnknown)
  protected
    function QueryInterface(constref IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

  TDomBaseComponent = class(TComponent)
  protected
    function GetXDOMVersion: WideString;
  public
    property XDOMVersion: WideString read GetXDOMVersion;
  end;

  TDomImplementation = class(TDomBaseComponent)
  private
    FErrorReportLevel: Word;
    FResourceResolver: TCustomResourceResolver;

    FOnAttrModified: TDomAttrModifiedEvent;
    FOnCharacterDataModified: TDomNotifyNodeEvent;
    FOnError: TDomErrorEvent;
    FOnNodeClearing: TDomNotifyNodeEvent;
    FOnNodeInserted: TDomNotifyNodeEvent;
    FOnNodeRemoving: TDomNotifyNodeEvent;
    FOnRequestXPathFunctionResult: TDomRequestXPathFunctionResultEvent;
    FOnRequestXPathVariable: TDomRequestXPathVariableEvent;

    procedure Attach(ADocument: TDomCustomDocument);
    procedure DestroyOwnedDocuments;
    procedure Detach(ADocument: TDomCustomDocument);
    function GetErrorEventsDisabled: Boolean;
  protected
    FDocuments: TDomNodeList;
    FOwnedDocumentsList: TList;
    procedure DoAttrModified(const ModifiedNode: TDomNode;
                             const AttrChange: TDomAttrChange;
                             const RelatedAttr: TDomAttr); virtual;
    procedure DoCharacterDataModified(ModifiedNode: TDomNode); virtual;
    procedure DoError(    Sender: TObject;
                          Error: TDomError;
                      var Go: Boolean); virtual;
    procedure DoNodeClearing(Node: TDomNode); virtual;
    procedure DoNodeInserted(Node: TDomNode); virtual;
    procedure DoNodeRemoving(Node: TDomNode); virtual;
    procedure DoRequestXPathFunctionResult(const NamespaceURI,
                                                 LocalName: WideString;
                                           const ContextNode: TDomNode;
                                           const ContextPosition: Integer;
                                           const ContextSize: Integer;
                                           const Arguments: TList;
                                             var Value: TDomXPathCustomResult); virtual;
    procedure DoRequestXPathVariable(const XPathExpression: TXPathExpression;
                                     const NamespaceURI,
                                           LocalName: WideString;
                                       var Value: TDomXPathCustomResult); virtual;
    function GetDocuments: TDomNodeList; virtual;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure SetResourceResolver(const AResourceResolver: TCustomResourceResolver); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear; virtual;
    procedure DisableErrorEvents; virtual;
    procedure EnableErrorEvents; virtual;
    function HandleError(const Sender: TObject;
                         const Error: TDomError): Boolean; virtual;
    function ResolveResourceAsStream(const ABaseURI: WideString;
                                       var PublicId,
                                           SystemId: WideString): TStream; virtual;
    procedure ResolveResourceAsWideString(const ABaseURI: WideString;
                                            var PublicId,
                                                SystemId: WideString;
                                            out S: WideString;
                                            out Error: TXmlErrorType); virtual;
    property Documents: TDomNodeList read GetDocuments;
    property ErrorEventsDisabled: Boolean read GetErrorEventsDisabled;
  published
    property ResourceResolver: TCustomResourceResolver read FResourceResolver write SetResourceResolver;

    property OnAttrModified:          TDomAttrModifiedEvent read FOnAttrModified write FOnAttrModified;
    property OnCharacterDataModified: TDomNotifyNodeEvent read FOnCharacterDataModified write FOnCharacterDataModified;
    property OnError:                 TDomErrorEvent read FOnError write FOnError;
    property OnNodeClearing:          TDomNotifyNodeEvent read FOnNodeClearing write FOnNodeClearing;
    property OnNodeInserted:          TDomNotifyNodeEvent read FOnNodeInserted write FOnNodeInserted;
    property OnNodeRemoving:          TDomNotifyNodeEvent read FOnNodeRemoving write FOnNodeRemoving;
    property OnRequestXPathFunctionResult:  TDomRequestXPathFunctionResultEvent read FOnRequestXPathFunctionResult write FOnRequestXPathFunctionResult;
    property OnRequestXPathVariable:  TDomRequestXPathVariableEvent read FOnRequestXPathVariable write FOnRequestXPathVariable;
  end;

  TDomNodeFilter = class
  public
    function AcceptNode(const N: TDomNode): TDomFilterResult; virtual; abstract;
  end;

  TDomTreeWalker = class
  private
    FCurrentNode: TDomNode;
    FExpandEntityReferences: Boolean;
    FFilter: TDomNodeFilter;
    FRoot: TDomNode;
    FWhatToShow: TDomWhatToShow;
  protected
    function FindFirstChild(const OldNode: TDomNode): TDomNode; virtual;
    function FindLastChild(const OldNode: TDomNode): TDomNode; virtual;
    function FindNextNode(OldNode: TDomNode): TDomNode; virtual;
    function FindNextSibling(const OldNode: TDomNode): TDomNode; virtual;
    function FindParentNode(const OldNode: TDomNode): TDomNode; virtual;
    function FindPreviousNode(const OldNode: TDomNode): TDomNode; virtual;
    function FindPreviousSibling(const OldNode: TDomNode): TDomNode; virtual;
    procedure SetCurrentNode(const Node: TDomNode); virtual;
    procedure SetExpandEntityReferences(const Value: Boolean); virtual;  // Derived classes may move this method to the public section to allow write access.
    procedure SetFilter(const Value: TDomNodeFilter); virtual;           // Derived classes may move this method to the public section to allow write access.
    procedure SetRoot(const Node: TDomNode); virtual;                    // Derived classes may move this method to the public section to allow write access.
    procedure SetWhatToShow(const Value: TDomWhatToShow); virtual;       // Derived classes may move this method to the public section to allow write access.
  public
    constructor Create(const Root: TDomNode;
                       const WhatToShow: TDomWhatToShow;
                       const NodeFilter: TDomNodeFilter;
                       const EntityReferenceExpansion: Boolean); virtual;
    function ParentNode: TDomNode; virtual;
    function FirstChild: TDomNode; virtual;
    function LastChild: TDomNode; virtual;
    function PreviousSibling: TDomNode; virtual;
    function NextSibling: TDomNode; virtual;
    function NextNode: TDomNode; virtual;
    function PreviousNode: TDomNode; virtual;
    property CurrentNode: TDomNode read FCurrentNode write SetCurrentNode;
    property ExpandEntityReferences: Boolean read FExpandEntityReferences;
    property Filter: TDomNodeFilter read FFilter;
    property Root: TDomNode read FRoot;
    property WhatToShow: TDomWhatToShow read FWhatToShow;
  end;

  TDomNodeIterator = class
  private
    FRoot: TDomNode;
    FReferenceNode: TDomNode;
    FPosition: TDomPosition; // Position of the Iterator relativ to FReferenceNode
    FWhatToShow: TDomWhatToShow;
    FExpandEntityReferences: Boolean;
    FFilter: TDomNodeFilter;
    FInvalid: Boolean;
  protected
    procedure HandleNodeEvent(const Node: TDomNode;
                              const EventType: TDomNodeEvent); virtual; // Used to receive notifications about node events.
    function FindNextNode(OldNode: TDomNode): TDomNode; virtual;
    function FindPreviousNode(const OldNode: TDomNode): TDomNode; virtual;
  public
    constructor Create(const Root: TDomNode;
                       const WhatToShow: TDomWhatToShow;
                       const NodeFilter: TDomNodeFilter;
                       const EntityReferenceExpansion: Boolean); virtual;
    procedure Detach; virtual;
    function NextNode: TDomNode; virtual;
    function PreviousNode: TDomNode; virtual;
    property ExpandEntityReferences: Boolean read FExpandEntityReferences;
    property Filter: TDomNodeFilter read FFilter;
    property Root: TDomNode read FRoot;
    property WhatToShow: TDomWhatToShow read FWhatToShow;
  end;

  TDomNodeList = class
  private
    FNodeList: TList;
  protected
    function GetLength: Integer; virtual;
    function IndexOf(const Node: TDomNode): Integer; virtual;
  public
    constructor Create(const NodeList: TList);
    function Item(const Index: Integer): TDomNode; virtual;
    property Length: Integer read GetLength;
  end;

  TDomElementsNodeList = class(TDomNodeList)
  private
    FQueryName: WideString;
    FStartElement: TDomNode;
  protected
    function GetLength: Integer; override;
  public
    function IndexOf(const Node: TDomNode): Integer; override;
    function Item(const Index: Integer): TDomNode; override;
    constructor Create(const QueryName: WideString;
                       const StartElement: TDomNode); virtual;
  end;

  TDomElementsNodeListNS = class(TDomNodeList)
  private
    FQueryNamespaceURI: WideString;
    FQueryLocalName: WideString;
    FStartElement: TDomNode;
  protected
    function GetLength: Integer; override;
  public
    function IndexOf(const Node: TDomNode): Integer; override;
    function Item(const Index: Integer): TDomNode; override;
    constructor Create(const QueryNamespaceURI,
                             QueryLocalName: WideString;
                       const StartElement: TDomNode); virtual;
  end;

  TDomCustomNode = class(TCustomOwnedNode)
  protected
    function GetNodeName: WideString; virtual; abstract;
    procedure RaiseException(const E: ExceptClass); override;
  public
    property NodeName: WideString read GetNodeName;
  end;

  TDomCustomNodeClass = class of TDomCustomNode;

  TDomOwnerNamedNodeMap = class(TPersistent)
  private
    FItemClass: TDomCustomNodeClass;
    FNodeList: TUtilsWideStringList;
  protected
    function GetCount: Integer; virtual;
    function GetItems(Index: Integer): TDomCustomNode; virtual;
  public
    constructor Create(const AItemClass: TDomCustomNodeClass);
    destructor Destroy; override;
    function Add(const Node: TDomCustomNode): Integer; virtual;
    procedure Clear; virtual;
    procedure Delete(const Index: Integer); virtual;
    function ExtractItem(const Node: TDomCustomNode): TDomCustomNode; virtual;
    function GetNamedItem(const Name: WideString): TDomCustomNode; virtual;
    function HasNamedItem(const Name: WideString): Boolean; virtual;
    function IndexOfItem(const Node: TDomCustomNode): Integer; virtual;
    function IndexOfNamedItem(const Name: WideString): Integer; virtual;
    function RemoveItem(const Node: TDomCustomNode): Integer; virtual;
    function RemoveNamedItem(const Name: WideString): Integer; virtual;
    property ItemClass: TDomCustomNodeClass read FItemClass;
    property Items[Index: Integer]: TDomCustomNode read GetItems; default;
    property Count: Integer read GetCount;
  end;

  TDomNamedNodeMap = class(TDomNodeList)
  private
    FAllowedNodeTypes: TDomWhatToShow;
    FDefaultNamespaceAware: Boolean;
    FOwnerNode: TDomNode;
  protected
    procedure CheckAllowedNodeType(const Node: TDomNode);
    procedure CheckHasNode(const Node: TDomNode);
    procedure CheckNamespaceAware;
    procedure CheckNotInUse(const Node: TDomNode);
    procedure CheckNotNamespaceAware;
    procedure CheckNotReadOnly;
    procedure CheckSameRootDocument(const Node: TDomNode);
    function GetNamespaceAware: Boolean;
    function GetReadOnly: Boolean;
    procedure InternalAdd(const Node: TDomNode); virtual;
    procedure InternalRemove(const Node: TDomNode); virtual;
    function RemoveItem(const Arg: TDomNode): TDomNode; virtual;
  public
    constructor Create(const AOwner: TDomNode;
                       const NodeList: TList;
                       const AllowedNTs: TDomWhatToShow;
                       const DefaultNamespaceAware: Boolean); virtual;
    function GetNamedItem(const Name: WideString): TDomNode; virtual;
    function GetNamedItemNS(const NamespaceURI,
                                  LocalName: WideString): TDomNode; virtual;
    function RemoveNamedItem(const Name: WideString): TDomNode; virtual;
    function RemoveNamedItemNS(const NamespaceURI,
                                     LocalName: WideString): TDomNode; virtual;
    function SetNamedItem(const Arg: TDomNode): TDomNode; virtual;
    function SetNamedItemNS(const Arg: TDomNode): TDomNode; virtual;
    property NamespaceAware: Boolean read GetNamespaceAware;
    property OwnerNode: TDomNode read FOwnerNode;
    property readOnly: Boolean read GetReadOnly;
  end;

  TDomNode = class (TDomCustomNode)
  private
    FIsNamespaceNode: Boolean;
    FNodeList: TDomNodeList;
    FNodeValue: WideString;
    FOwnerDocument: TDomCustomDocument;
    FUserData: TUtilsWideStringList;
    FUserDataHandlers: TList;
    procedure MakeChildrenReadOnly;
    function PreviousNode: TDomNode;
    function HasEntRef(const EntName: widestring): Boolean;
  protected
    FAllowedChildTypes: set of TDomNodeType;
    procedure CheckTypeAllowed(const Node: TDomNode); virtual;
    procedure DoAfterAddition(const Node: TCustomOwnedNode); override;
    procedure DoBeforeClear; override;
    procedure DoBeforeRemoval(const Node: TCustomOwnedNode); override;
    function GetAbsoluteIndex: Integer; virtual;
    function GetAttributes: TDomNamedNodeMap; virtual;
    function GetBaseUri: WideString; virtual;
    function GetChildNodes: TDomNodeList; virtual;
    function GetDocument: TDomCustomDocument; virtual;
    function GetExpandedName: WideString; virtual;
    function GetFirstChild: TDomNode; reintroduce; virtual;
    function GetLanguage: WideString; virtual;
    function GetLastChild: TDomNode; reintroduce; virtual;
    function GetLevel: Integer; virtual;
    function GetLocalName: WideString; virtual;
    function GetNamespaceURI: WideString; virtual;
    function GetNextSibling: TDomNode; reintroduce; virtual;
    function GetNodeName: WideString; override;
    function GetNodeValue: WideString; virtual;
    function GetNodeType: TDomNodeType; virtual;
    function GetParentNode: TDomNode; virtual;
    function GetPreviousSibling: TDomNode; reintroduce; virtual;
    function GetPrefix: WideString; virtual;
    function GetRootDocument: TDomCustomDocument; virtual;
    function GetTextContent: WideString; virtual;
    function GetXPathStringValue: WideString; virtual;
    procedure SetNodeValue(const Value: WideString); virtual;
    procedure SetPrefix(const Value: WideString); virtual;
  public
    constructor Create(const AOwner: TCustomOwnedObject);
    destructor Destroy; override;
    function  AppendChild(const NewChild: TDomNode): TDomNode; virtual;
    procedure Clear; override;
    function  CloneNode(const Deep: Boolean): TDomNode; virtual;
    function  CompareDocumentPosition(const Other: TDomNode): TDomDocumentPosition; virtual;
    function  EvaluateToBoolean(const Expression: WideString): Boolean; virtual;
    function  EvaluateToNumber(const Expression: WideString): Double; virtual;
    function  EvaluateToNode(const Expression: WideString): TDomNode; virtual;
    function  EvaluateToWideString(const Expression: WideString): WideString; virtual;
    function  FindFirstChildElement: TDomElement; virtual;
    function  FindLastChildElement: TDomElement; virtual;
    function  FindNextSiblingElement: TDomElement; virtual;
    function  FindParentElement: TDomElement; virtual;
    function  FindPreviousSiblingElement: TDomElement; virtual;
    function  GetFirstChildElement(const Name: WideString): TDomElement; virtual;
    function  GetFirstChildElementNS(const NamespaceURI,
                                           LocalName: WideString): TDomElement; virtual;
    function  GetLastChildElement(const Name: WideString): TDomElement; virtual;
    function  GetLastChildElementNS(const NamespaceURI,
                                          LocalName: WideString): TDomElement; virtual;
    function  GetNextSiblingElement(const Name: WideString): TDomElement; virtual;
    function  GetNextSiblingElementNS(const NamespaceURI,
                                            LocalName: WideString): TDomElement; virtual;
    function  GetParentElement(const Name: WideString): TDomElement; virtual;
    function  GetParentElementNS(const NamespaceURI,
                                       LocalName: WideString): TDomElement; virtual;
    function  GetPreviousSiblingElement(const Name: WideString): TDomElement; virtual;
    function  GetPreviousSiblingElementNS(const NamespaceURI,
                                                LocalName: WideString): TDomElement; virtual;
    function  GetUserData(const Key: WideString): TObject; virtual;
    function  HasAsAncestor(const Node: TDomNode): Boolean; reintroduce; virtual;
    function  HasAttributes: Boolean; virtual;
    function  HasChildNodes: Boolean; virtual;
    function  InsertBefore(const NewChild,
                                 RefChild: TDomNode): TDomNode; reintroduce; virtual;
    function  LookupNamespaceURI(const APrefix: WideString): WideString; virtual;
    procedure Normalize; virtual;
    function  RemoveChild(const OldChild: TDomNode): TDomNode; virtual;
    function  ReplaceChild(const NewChild,
                                 OldChild: TDomNode): TDomNode; virtual;
    function  SetUserData(const Key: WideString;
                          const Data: TObject;
                          const Handler: TDomUserDataEvent): TObject; virtual;
    function  Supports(const Feature,
                             Version: WideString): Boolean; virtual;

    property AbsoluteIndex:     Integer            read GetAbsoluteIndex;
    property Attributes:        TDomNamedNodeMap   read GetAttributes;
    property BaseUri:           WideString         read GetBaseUri;
    property ChildNodes:        TDomNodeList       read GetChildNodes;
    property ExpandedName:      WideString         read GetExpandedName;
    property FirstChild:        TDomNode           read GetFirstChild;
    property IsNamespaceNode:   Boolean            read FIsNamespaceNode;
    property IsReadonly:        Boolean            read GetReadOnly;
    property Language:          WideString         read GetLanguage;
    property LastChild:         TDomNode           read GetLastChild;
    property Level:             Integer            read GetLevel;
    property LocalName:         WideString         read GetLocalName;
    property NamespaceURI:      WideString         read GetNamespaceURI;
    property NextSibling:       TDomNode           read GetNextSibling;
    property NodeType:          TDomNodeType       read GetNodeType;
    property NodeValue:         WideString         read GetNodeValue write SetNodeValue;
    property OwnerDocument:     TDomCustomDocument read GetDocument;
    property ParentNode:        TDomNode           read GetParentNode;
    property PreviousSibling:   TDomNode           read GetPreviousSibling;
    property Prefix:            WideString         read GetPrefix    write SetPrefix;
    property RootDocument:      TDomCustomDocument read GetRootDocument;
    property TextContent:       WideString         read GetTextContent;
    property XPathStringValue:  WideString         read GetXPathStringValue;
  end;

  TDomCharacterData = class (TDomNode)
  private
    function GetData: WideString; virtual;
    procedure SetData(const Value: WideString); virtual;
    function GetLength: Integer; virtual;
  protected
    procedure DoCharacterDataModified; virtual;
  public
    constructor Create(const AOwner: TDomCustomDocument);
    function SubstringData(const Offset,
                                 Count: Integer): WideString; virtual;
    procedure AppendData(const Arg: WideString); virtual;
    procedure InsertData(const Offset: Integer;
                         const Arg: WideString); virtual;
    procedure DeleteData(const Offset,
                               Count: Integer); virtual;
    procedure ReplaceData(const Offset,
                                Count: Integer;
                          const Arg: WideString); virtual;
    property Data: WideString read GetData write SetData;
    property Length: Integer read GetLength;
  end;

  TDomAttr = class (TDomNode)
  private
    FIsXmlnsDecl: TDomXmlnsDeclType;
    FLocalName: WideString;
    FNamespaceURI: WideString;
    FNodeName: WideString;
    FOwnerMap: TDomNamedNodeMap;
    FPrefix: WideString;
    function GetDataType: TXmlDataType;
  protected
    FSpecified: Boolean;
    procedure DoAttrModified(const AttrChange: TDomAttrChange); virtual;
    function GetExpandedName: WideString; override;
    function GetIsXmlnsDecl: TDomXmlnsDeclType; virtual;
    function GetLocalName: WideString; override;
    function GetName: WideString; virtual;
    function GetNamespaceURI: WideString; override;
    function GetNextSibling: TDomNode; override;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    function GetOwnerElement: TDomElement; virtual;
    function GetPrefix: WideString; override;
    function GetPreviousSibling: TDomNode; override;
    function GetSpecified: Boolean; virtual;
    function GetValue: WideString; virtual;
    procedure SetNodeValue(const Value: WideString); override;
    procedure SetPrefix(const Value: WideString); override;
  public
    constructor Create(const AOwner: TDomDocument;
                       const Name: WideString;
                       const Spcfd: Boolean);
    constructor CreateNS(const AOwner: TDomDocumentNS;
                         const NamespaceURI,
                               QualifiedName: WideString;
                         const Spcfd: Boolean);
    destructor Destroy; override;
    function LookupNamespaceURI(const APrefix: WideString): WideString; override;

    property DataType: TXmlDataType read GetDataType;
    property IsXmlnsDecl: TDomXmlnsDeclType read GetIsXmlnsDecl;
    property Name: WideString read GetName;
    property OwnerElement: TDomElement read GetOwnerElement;
    property Specified: Boolean read GetSpecified;
    property Value: WideString read GetValue;
  end;

  TDomElement = class (TDomNode)
  private
    FAttributeList: TDomNamedNodeMap;
    FAttributeListing: TList;
    FCreatedElementsNodeListNSs: TList;
    FCreatedElementsNodeLists: TList;
    FLocalName: WideString;
    FNamespaceURI: WideString;
    FNodeName: WideString;
    FPrefix: WideString;
  protected
    procedure DoAttrModified(const originalTarget: TDomNode;
                             const AttrChange: TDomAttrChange;
                             const RelatedAttr: TDomAttr); virtual;
    procedure DoBeforeClear; override;
    function GetExpandedName: WideString; override;
    function GetLocalName: WideString; override;
    function GetNamespaceURI: WideString; override;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    function GetPrefix: WideString; override;
    procedure SetNodeValue(const Value: WideString); override;
    procedure SetPrefix(const Value: WideString); override;
  public
    constructor Create(const AOwner: TDomDocument;
                       const TagName: WideString);
    constructor CreateNS(const AOwner: TDomDocumentNS;
                         const NamespaceURI,
                               QualifiedName: WideString);
    destructor Destroy; override;
    function GetAttributeLiteralValue(const Name: WideString): WideString; virtual;
    function GetAttributeNode(const Name: WideString): TDomAttr; virtual;
    function GetAttributeNodeNS(const NamespaceURI,
                                      LocalName: WideString): TDomAttr; virtual;
    function GetAttributeNormalizedValue(const Name: WideString): WideString; virtual;
    function GetAttributeNSLiteralValue(const NamespaceURI,
                                              LocalName: WideString): WideString; virtual;
    function GetAttributeNSNormalizedValue(const NamespaceURI,
                                                 LocalName: WideString): WideString; virtual;
    function GetAttributes: TDomNamedNodeMap; override;
    function GetElementsByTagName(const Name: WideString): TDomNodeList; virtual;
    function GetElementsByTagNameNS(const NamespaceURI,
                                          LocalName: WideString): TDomNodeList; virtual;
    function GetTagName: WideString; virtual;
    function HasAttribute(const Name: WideString): Boolean; virtual;
    function HasAttributeNS(const NamespaceURI,
                                  LocalName: WideString): Boolean; virtual;
    function LookupNamespaceURI(const APrefix: WideString): WideString; override;
    procedure Normalize; override;
    function RemoveAttribute(const Name: WideString): TDomAttr; virtual;
    function RemoveAttributeNode(const OldAttr: TDomAttr): TDomAttr; virtual;
    function RemoveAttributeNS(const NamespaceURI,
                                     LocalName: WideString): TDomAttr; virtual;
    function SetAttribute(const Name,
                                Value: WideString): TDomAttr; virtual;
    function SetAttributeNode(const NewAttr: TDomAttr): TDomAttr; virtual;
    function SetAttributeNodeNS(const NewAttr: TDomAttr): TDomAttr; virtual;
    function SetAttributeNS(const NamespaceURI,
                                  QualifiedName,
                                  Value: WideString): TDomAttr; virtual;

    property TagName: WideString read GetTagName;
  end;

  TDomText = class (TDomCharacterData)
  private
    FCharRefGenerated: Boolean;
  protected
    function GetIsElementContentWhitespace: Boolean; virtual;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
  public
    constructor Create(const AOwner: TDomCustomDocument);
    function SplitText(const Offset: Integer): TDomText; virtual;

    property CharRefGenerated: Boolean read FCharRefGenerated write FCharRefGenerated default False;
    property IsElementContentWhitespace: Boolean read GetIsElementContentWhitespace;
  end;

  TDomComment = class (TDomCharacterData)
  protected
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
  public
    constructor Create(const AOwner: TDomCustomDocument);
  end;

  TDomProcessingInstruction = class (TDomNode)
  private
    FTarget: WideString;
  protected
    procedure DoCharacterDataModified; virtual;
    function GetData: WideString; virtual;
    function GetExpandedName: WideString; override;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    procedure SetData(const Value: WideString); virtual;
  public
    constructor Create(const AOwner: TDomCustomDocument;
                       const Targ: WideString);

    property Target: WideString read FTarget;
    property Data: WideString read GetData write SetData;
  end;

  TDomCDATASection = class (TDomText)
  protected
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
  public
    constructor Create(const AOwner: TDomCustomDocument);
  end;

  TDomDocumentTypeDecl = class (TDomNode)
  private
    FInternalSubset: WideString;
    FIntSubsetStartColumn: Int64;
    FIntSubsetCharNumber: Int64;
    FIntSubsetByteNumber: Int64;
    FIntSubsetStartLine: Int64;
    FNodeName: WideString;
    FPublicId: WideString;
    FSystemId: WideString;
  protected
    function GetInternalSubset: WideString; virtual;
    function GetName: WideString; virtual;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    function GetPublicId: WideString; virtual;
    function GetSystemId: WideString; virtual;
    procedure SetNodeValue(const Value: WideString); override;
  public
    constructor Create(const AOwner: TDomCustomDocument;
                       const DoctypeName,
                             PubId,
                             SysId,
                             IntSubset: WideString);

    property InternalSubset: WideString read GetInternalSubset;
    property IntSubsetStartByteNumber: Int64 read FIntSubsetByteNumber write FIntSubsetByteNumber default 0;
    property IntSubsetStartCharNumber: Int64 read FIntSubsetCharNumber write FIntSubsetCharNumber default 0;
    property IntSubsetStartColumn: Int64 read FIntSubsetStartColumn write FIntSubsetStartColumn default 0;
    property IntSubsetStartLine: Int64 read FIntSubsetStartLine write FIntSubsetStartLine default 1;
    property Name: WideString read GetName;
    property PublicId: WideString read GetPublicId;
    property SystemId: WideString read GetSystemId;
  end;

  TDomEntityReference = class (TDomNode)
  private
    FNodeName: WideString;
  protected
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    procedure SetNodeValue(const Value: WideString); override;
  public
    constructor Create(const AOwner: TDomCustomDocument;
                       const Name: WideString);
  end;

  TDomDocumentFragment = class (TDomNode)
  protected
    function GetAbsoluteIndex: Integer; override;
    function GetLevel: Integer; override;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    procedure SetNodeValue(const Value: WideString); override;
  public
    constructor Create(const AOwner: TDomCustomDocument); virtual;
  end;

  TDomXPathNamespace = class (TDomNode)
  private
    FNamespaceURI: WideString;
    FOwnerElement: TDomElement;
    FPrefix: WideString;
    function GetOwnerSet: TDomXPathNodeSetResult;
  protected
    function GetDocument: TDomCustomDocument; override;
    function GetExpandedName: WideString; override;
    function GetLocalName: WideString; override;
    function GetNamespaceURI: WideString; override;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    function GetNodeValue: WideString; override;
    function GetOwnerElement: TDomElement; virtual;
    function GetPrefix: WideString; override;
  public
    constructor Create(const AOwnerSet: TDomXPathNodeSetResult;
                       const AOwnerElement: TDomElement;
                       const ANamespaceUri,
                             APrefix: WideString);
    property OwnerElement: TDomElement read GetOwnerElement;
    property OwnerSet: TDomXPathNodeSetResult read GetOwnerSet;
    function LookupNamespaceURI(const APrefix: WideString): WideString; override;
  end;

  TDomCustomDocument = class (TDomNode)
  private
    FCreatedNodeIterators: TList;
    FCreatedTreeWalkers: TList;
    FDefaultView: TDomAbstractView;
    FDocumentUri: WideString;
    FDOMImpl: TDomImplementation;
    FInputEncoding: WideString;
    FModified: Boolean;
    FSystemId: WideString;
    FXmlEncoding: WideString;
    FXmlStandalone: TDomStandalone;
    FXmlVersion: WideString;

    FOnAttrModified: TDomAttrModifiedEvent;
    FOnCharacterDataModified: TDomNotifyNodeEvent;
    FOnNodeClearing: TDomNotifyNodeEvent;
    FOnNodeInserted: TDomNotifyNodeEvent;
    FOnNodeRemoving: TDomNotifyNodeEvent;

    procedure NotifyIterators(const Node: TDomNode;
                              const EventType: TDomNodeEvent);
  protected
    procedure CalculateNormalizedAttrValue(const AttrLiteralValue: WideString;
                                           const AttrDataType: TXmlDataType;
                                             out NormalizedValue: WideString;
                                             out Error: TXmlErrorType); virtual;
    procedure DoAttrModified(const SourceNode: TDomNode;
                             const AttrChange: TDomAttrChange;
                             const RelatedAttr: TDomAttr); virtual;
    procedure DoBeforeClear; override;
    procedure DoCharacterDataModified(Node: TDomNode); virtual;
    procedure DoNodeClearing(Node: TDomNode); virtual;
    procedure DoNodeInserted(Node: TDomNode); virtual;
    procedure DoNodeRemoving(Node: TDomNode); virtual;
    function GetAbsoluteIndex: Integer; override;
    function GetAttrDataType(const ElementName,
                                   AttrName: WideString): TXmlDataType; virtual;
    function GetBaseUri: WideString; override;
    function GetDoctypeDecl: TDomDocumentTypeDecl; virtual;
    function GetDocumentElement: TDomElement; virtual;
    function GetLevel: Integer; override;
    function GetNodeName: WideString; override;
    function GetNodeType: TDomNodeType; override;
    function GetRootDocument: TDomCustomDocument; override;
    function ImportNode2(const ImportedNode: TDomNode;
                         const Deep: Boolean): TDomNode; virtual;
    procedure SetNodeValue(const Value: WideString); override;
  public
    constructor Create(const AOwner: TDomImplementation);
    destructor Destroy; override;
    function AppendChild(const NewChild: TDomNode): TDomNode; override;
    procedure ClearInvalidNodeIterators; virtual;
    function CreateNodeIterator(const Root: TDomNode;
                                      WhatToShow: TDomWhatToShow;
                                      NodeFilter: TDomNodeFilter;
                                      EntityReferenceExpansion: Boolean): TDomNodeIterator; virtual;
    function CreateTreeWalker(const Root: TDomNode;
                                    WhatToShow: TDomWhatToShow;
                                    NodeFilter: TDomNodeFilter;
                                    EntityReferenceExpansion: Boolean): TDomTreeWalker; virtual;
    procedure FreeTreeWalker(var TreeWalker: TDomTreeWalker); virtual;
    function GetElementById(const ElementId: WideString): TDomElement; virtual; abstract;
    function ImportNode(const ImportedNode: TDomNode;
                        const Deep: Boolean): TDomNode; virtual;
    function InsertBefore(const NewChild,
                                RefChild: TDomNode): TDomNode; override;
    function ReplaceChild(const NewChild,
                                OldChild: TDomNode): TDomNode; override;

    property DefaultView: TDomAbstractView read FDefaultView;
    property DoctypeDecl: TDomDocumentTypeDecl read GetDoctypeDecl;
    property DocumentElement: TDomElement read GetDocumentElement;
    property DocumentUri: WideString read FDocumentUri write FDocumentUri;
    property DomImplementation: TDomImplementation read FDomImpl;
    property InputEncoding: WideString read FInputEncoding write FInputEncoding;
    property Modified: Boolean read FModified write FModified;
    property XmlEncoding: WideString read FXmlEncoding write FXmlEncoding;
    property XmlStandalone: TDomStandalone read FXmlStandalone write FXmlStandalone;
    property XmlVersion: WideString read FXmlVersion write FXmlVersion;

    property OnAttrModified:          TDomAttrModifiedEvent read FOnAttrModified write FOnAttrModified;
    property OnCharacterDataModified: TDomNotifyNodeEvent read FOnCharacterDataModified write FOnCharacterDataModified;
    property OnNodeClearing:          TDomNotifyNodeEvent read FOnNodeClearing write FOnNodeClearing;
    property OnNodeInserted:          TDomNotifyNodeEvent read FOnNodeInserted write FOnNodeInserted;
    property OnNodeRemoving:          TDomNotifyNodeEvent read FOnNodeRemoving write FOnNodeRemoving;
  end;

  TDomDocument = class(TDomCustomDocument)
  private
    FCreatedElementsNodeLists: TList;
    FValidationAgent: TDtdValidationAgent;
  protected
    procedure CalculateNormalizedAttrValue(const AttrLiteralValue: WideString;
                                           const AttrDataType: TXmlDataType;
                                             out NormalizedValue: WideString;
                                             out Error: TXmlErrorType); override;
    procedure DoBeforeClear; override;
    function GetAttrDataType(const ElementName,
                                   AttrName: WideString): TXmlDataType; override;
    function GetIsElementContentWhitespace(const TextNode: TDomText): Boolean; virtual;
    function ImportNode2(const ImportedNode: TDomNode;
                         const Deep: Boolean): TDomNode; override;
    function PrepareAttributes2(const Node: TDomNode): Boolean; virtual;
  public
    constructor Create(const AOwner: TDomImplementation);
    destructor Destroy; override;
    function GetElementById(const ElementId: WideString): TDomElement; override;
    function GetElementsByTagName(const TagName: WideString): TDomNodeList; virtual;
    function PrepareAttributes: Boolean; virtual;

    property ValidationAgent: TDtdValidationAgent read FValidationAgent;
  end;

  TDomDocumentNS = class(TDomCustomDocument)
  private
    FCreatedElementsNodeListNSs: TList;
    FIDs: TUtilsWideStringList;
    procedure SetIDs(const Value: TUtilsWideStringList);
  protected
    procedure DoBeforeClear; override;
  public
    constructor Create(const AOwner: TDomImplementation);
    destructor Destroy; override;
    function GetElementById(const ElementId: WideString): TDomElement; override;
    function GetElementsByTagNameNS(const NamespaceURI,
                                          LocalName: WideString): TDomNodeList; virtual;

    property IDs: TUtilsWideStringList read FIDs write SetIDs;
  end;

  TDomDocumentXPath = class(TDomDocumentNS)
  protected
    procedure DoBeforeAttach(const Obj: TCustomOwnedObject); override;
  end;

  TXmlStandardDomReader = class;

  TDomSeverity = (DOM_SEVERITY_WARNING,
                  DOM_SEVERITY_ERROR,
                  DOM_SEVERITY_FATAL_ERROR);

  IDomLocator = interface
    function GetEndByteNumber: Int64; stdcall;
    function GetEndCharNumber: Int64; stdcall;
    function GetEndColumnNumber: Int64; stdcall;
    function GetEndLineNumber: Int64; stdcall;
    function GetEndTabsInLine: Int64; stdcall;
    function GetRelatedDtdObject: TDtdObject; stdcall;
    function GetRelatedNode: TDomNode; stdcall;
    function GetStartByteNumber: Int64; stdcall;
    function GetStartCharNumber: Int64; stdcall;
    function GetStartColumnNumber: Int64; stdcall;
    function GetStartLineNumber: Int64; stdcall;
    function GetStartTabsInLine: Int64; stdcall;
    function GetUri: WideString; stdcall;

    property EndByteNumber: Int64 read GetEndByteNumber;
    property EndCharNumber: Int64 read GetEndCharNumber;
    property EndColumnNumber: Int64 read GetEndColumnNumber;
    property EndLineNumber: Int64 read GetEndLineNumber;
    property EndTabsInLine: Int64 read GetEndTabsInLine;
    property RelatedDtdObject: TDtdObject read GetRelatedDtdObject;
    property RelatedNode: TDomNode read GetRelatedNode;
    property StartByteNumber: Int64 read GetStartByteNumber;
    property StartCharNumber: Int64 read GetStartCharNumber;
    property StartColumnNumber: Int64 read GetStartColumnNumber;
    property StartLineNumber: Int64 read GetStartLineNumber;
    property StartTabsInLine: Int64 read GetStartTabsInLine;
    property Uri: WideString read GetUri;
  end;

  TDomError = class(TUtilsNoRefCount, IDomLocator)
  private
    FClue:              WideString;
    FCode:              WideString;
    FEndByteNumber:     Int64;
    FEndCharNumber:     Int64;
    FEndColumnNumber:   Int64;
    FEndLineNumber:     Int64;
    FEndTabsInLine:     Int64;
    FRelatedDtdObject:  TDtdObject;
    FRelatedException:  TXmlErrorType;
    FRelatedNode:       TDomNode;
    FStartByteNumber:   Int64;
    FStartCharNumber:   Int64;
    FStartColumnNumber: Int64;
    FStartLineNumber:   Int64;
    FStartTabsInLine:   Int64;
    FUri:               WideString;
  protected
    function GetSeverity: TDomSeverity; virtual;

    { IDomLocator interface methods: }
    function GetEndByteNumber: Int64; virtual; stdcall;
    function GetEndCharNumber: Int64; virtual; stdcall;
    function GetEndColumnNumber: Int64; virtual; stdcall;
    function GetEndLineNumber: Int64; virtual; stdcall;
    function GetEndTabsInLine: Int64; virtual; stdcall;
    function GetRelatedDtdObject: TDtdObject; virtual; stdcall;
    function GetRelatedNode: TDomNode; virtual; stdcall;
    function GetStartByteNumber: Int64; virtual; stdcall;
    function GetStartCharNumber: Int64; virtual; stdcall;
    function GetStartColumnNumber: Int64; virtual; stdcall;
    function GetStartLineNumber: Int64; virtual; stdcall;
    function GetStartTabsInLine: Int64; virtual; stdcall;
    function GetUri: WideString; virtual; stdcall;
  public
    constructor Create(const ARelatedException: TXmlErrorType;
                       const AStartByteNumber,
                             AStartCharNumber,
                             AStartColumnNumber,
                             AStartLineNumber,
                             AStartTabsInLine,
                             AEndByteNumber,
                             AEndCharNumber,
                             AEndColumnNumber,
                             AEndLineNumber,
                             AEndTabsInLine: Int64;
                       const AUri: WideString;
                       const ARelatedDtdObject: TDtdObject;
                       const ARelatedNode: TDomNode;
                       const ACode,
                             AClue: WideString); virtual;
    constructor CreateFromLocator(const ARelatedException: TXmlErrorType;
                                  const ALocation: IDomLocator;
                                  const ACode,
                                        AClue: WideString); virtual;
    function CloneError: TDomError; virtual;

    property Clue: WideString read FClue;
    property Code: WideString read FCode;
    property RelatedException: TXmlErrorType read FRelatedException;
    property Severity: TDomSeverity read GetSeverity;

    { IDomLocator interface properties: }
    property EndByteNumber: Int64 read GetEndByteNumber;
    property EndCharNumber: Int64 read GetEndCharNumber;
    property EndColumnNumber: Int64 read GetEndColumnNumber;
    property EndLineNumber: Int64 read GetEndLineNumber;
    property EndTabsInLine: Int64 read GetEndTabsInLine;
    property RelatedDtdObject: TDtdObject read GetRelatedDtdObject;
    property RelatedNode: TDomNode read GetRelatedNode;
    property StartByteNumber: Int64 read GetStartByteNumber;
    property StartCharNumber: Int64 read GetStartCharNumber;
    property StartColumnNumber: Int64 read GetStartColumnNumber;
    property StartLineNumber: Int64 read GetStartLineNumber;
    property StartTabsInLine: Int64 read GetStartTabsInLine;
    property Uri: WideString read GetUri;
  end;

  TDomErrorClass = class of TDomError;

  TDtdObjectList = class
  private
    FNodeList: TList;
  protected
    procedure Clear;
    function AppendNode(const NewNode: TDtdObject): TDtdObject; virtual;
    procedure Delete(const Index: Integer); virtual;
    function IndexOf(const Node: TDtdObject): Integer; virtual;
    function InsertBefore(const NewNode,
                                RefNode: TDtdObject): TDtdObject; virtual;
    function GetLength: Integer; virtual;
    function RemoveNode(const OldNode: TDtdObject): TDtdObject; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    function Item(const Index: Integer): TDtdObject; virtual;
    property Length: Integer read GetLength;
  end;

  TDtdNamedObjectMap = class
  protected
    FObjectList: TList;
    FOwnerObject: TDtdModel;
    function GetLength: Integer; virtual;
    function RemoveNamedItem(const Name: WideString): TDtdObject; virtual;
    function SetNamedItem(const Arg: TDtdObject): TDtdObject; virtual;
    procedure Clear; virtual;
  public
    constructor Create(const AOwner: TDtdModel);
    destructor Destroy; override;
    function GetNamedItem(const Name: WideString): TDtdObject; virtual;
    function Item(const Index: Integer): TDtdObject; virtual;
    property Length: Integer read GetLength;
    property OwnerModel: TDtdModel read FOwnerObject;
  end;

  TDtdValidationAgent = class
  private
    FDtdModel: TDtdModel;
    FIDs: TUtilsWideStringList;
    FIDREFs: TUtilsWideStringList;   // Remark: Only used during validation.
    FOwnerDocument: TDomDocument;

    procedure AddDefaultAttr(const Elmt: TDomElement;
                             const AttrName,
                                   AttrValue: WideString);
    function GetDomImplementation: TDomImplementation;
    procedure NormalizeAttrValueStep1(const S: WideString;
                                      const AttrDeclKey: Int64;
                                        out S_Normalized: WideString;
                                        out Error: TXmlErrorType);
    procedure NormalizeValue(const AttrLiteralValue: WideString;
                             const AttrDataType: TXmlDataType;
                             const AttrDeclKey: Int64;
                               out NormalizedValue: WideString;
                               out Error: TXmlErrorType);
    function ParseWideString(const S: WideString): TDomDocumentFragment; overload;
  protected
    function AddDefaultAttributes(const Elmt: TDomElement): Boolean; virtual;
    procedure AddAndValidateDefaultAttributes(const Elmt: TDomElement;
                                                out IsValid,
                                                    AContinue: Boolean); virtual;
    procedure Clear; virtual;
    function DocumentIsStandalone: Boolean;
    function ExpandEntityReference(const EntRef: TDomEntityReference): TXmlErrorType; virtual;
    function FindAttributeDecl(const ElementName,
                                     AttributeName: WideString): TDtdAttributeDecl; virtual;
    function FindElementDecl(const Name: WideString): TDtdElementDecl; virtual;
    function FindEntityDecl(const Name: WideString): TDtdEntityDecl; virtual;
    function FindEntityReplacementText(const EntityName: WideString;
                                         out ReplText: WideString;
                                         out IsExternalEntity: Boolean;
                                         out Key: Int64): TXmlErrorType; virtual;
    function FindNotationDecl(const Name: WideString): TDtdNotationDecl; virtual;
    function GetAttrDataType(const ElementName,
                                   AttrName: WideString): TXmlDataType; virtual;
    function GetElementContentType(const ElementName: WideString): TDtdContentType; virtual;
    procedure NormalizeAttributeValue(const AttrLiteralValue: WideString;
                                      const AttrDataType: TXmlDataType;
                                        out NormalizedValue: WideString;
                                        out Error: TXmlErrorType); virtual;
    procedure NormalizeAttrDeclValue(const AttrDecl: TDtdAttributeDecl;
                                       out NormalizedValue: WideString;
                                       out Error: TXmlErrorType); virtual;
    procedure ResolveEntity(const Origin: TDtdOrigin;
                            const BaseURI,
                                  PubId,
                                  SysId: WideString;
                              out ReplacementText: WideString;
                              out Error: TXmlErrorType); virtual;
    function SendErrorNotification(const XmlErrorType: TXmlErrorType;
                                   const RelDtdObject: TDtdObject;
                                   const RelNode: TDomNode): Boolean; virtual;
    procedure ValidateAttr(const Attr: TDomAttr;
                           const Opt: TDomEntityResolveOption;
                             out IsValid,
                                 AContinue: Boolean); virtual;
    procedure ValidateDTD(out IsValid,
                              AContinue: Boolean); virtual;
    procedure ValidateElement(const Elmt: TDomElement;
                              const Opt: TDomEntityResolveOption;
                                out IsValid,
                                    AContinue: Boolean); virtual;
    procedure ValidateEntityRef(const EntRef: TDomEntityReference;
                                  out IsValid,
                                      AContinue: Boolean); virtual;
    procedure ValidateNode(const Node: TDomNode;
                           const Opt: TDomEntityResolveOption;
                             out IsValid,
                                 AContinue: Boolean); virtual;

    property DomImplementation: TDomImplementation read GetDomImplementation;
    property IDs: TUtilsWideStringList read FIDs;
  public
    constructor Create(const AOwner: TDomDocument);
    destructor Destroy; override;
    procedure BuildDtdModel(const ResolveExtEntities: Boolean); virtual;
    function ValidateDocument(const Opt: TDomEntityResolveOption): Boolean; virtual;

    property DtdModel: TDtdModel read FDtdModel;   
    property OwnerDocument: TDomDocument read FOwnerDocument;
  end;

  TDtdObject = class
  private
    FName: WideString;
    FObjectType: TDtdObjectType;
    FOwnerModel: TDtdModel;
    FKey: Int64;
  protected
    function GetName: WideString; virtual;
  public
    constructor Create(const AOwner: TDtdModel;
                       const AName: WideString);

    property Key: Int64 read FKey;
    property Name: WideString read GetName;
    property ObjectType: TDtdObjectType read FObjectType;
    property OwnerModel: TDtdModel read FOwnerModel;
  end;

  TDtdContentModel = class(TDtdObject)
  protected
    FAllowedChildTypes: set of TDtdContentModelType;
    FContentModelType: TDtdContentModelType;
    FFrequency: TDtdFrequency;
    FInuse: Boolean;
    FOwnerElementDecl: TDtdElementDecl;
    FSubModels: TDtdObjectList;
    function ValidateChoiceNames(const Source: TUtilsWideStringList;
                                   var Index: Integer;
                                       Freq: TDtdFrequency;
                                   out IsNonDeterministic: Boolean): Boolean; virtual;
    function ValidateElementNames(const Source: TUtilsWideStringList;
                                    var Index: Integer;
                                        Freq: TDtdFrequency;
                                    out IsNonDeterministic: Boolean): Boolean; virtual;
    function ValidateNames2(const Source: TUtilsWideStringList;
                              var Index: Integer;
                                  Freq: TDtdFrequency;
                              out IsNonDeterministic: Boolean): Boolean; virtual;
    function ValidateNames(const Source: TUtilsWideStringList;
                             var Index: Integer;
                             out IsNonDeterministic: Boolean): Boolean; virtual;
    function ValidateSequenceNames(const Source: TUtilsWideStringList;
                                     var Index: Integer;
                                         Freq: TDtdFrequency;
                                     out IsNonDeterministic: Boolean): Boolean; virtual;
  public
    constructor Create(const AOwnerElementDecl: TDtdElementDecl;
                       const AName: WideString;
                       const AContentModelType: TDtdContentModelType);
    destructor Destroy; override;
    function AppendSubModel(const NewCM: TDtdContentModel): TDtdContentModel; virtual;
    function InsertBeforeSubModel(const NewCM,
                                        RefCM: TDtdContentModel): TDtdContentModel; virtual;
    function RemoveSubModel(const OldCM: TDtdContentModel): TDtdContentModel; virtual;
    property ContentModelType: TDtdContentModelType read FContentModelType;
    property Frequency: TDtdFrequency read FFrequency write FFrequency default DTD_REQUIRED_FRQ;
    property SubModels: TDtdObjectList read FSubModels;
    property OwnerElementDecl: TDtdElementDecl read FOwnerElementDecl;
  end;

  TDtdAttDeclCollection = class(TDtdObject)
  private
    FAttributeDeclarations: TDtdNamedObjectMap;
  public
    constructor Create(const AOwner: TDtdModel;
                       const AName: WideString);
    destructor Destroy; override;
    procedure Clear; virtual;
    function FindAttributeDecl(const Name: WideString): TDtdAttributeDecl; virtual;
    function RemoveAttributeDecl(const Name: WideString): Boolean; virtual;
    function SetAttributeDecl(const AAttrName,
                                    AAttrValue: WideString;
                              const AEnumeration: TUtilsWideStringList;
                              const AAttrType: TXmlDataType;
                              const AConstraintType: TDomAttrValueConstraint;
                              const AOrigin: TDtdOrigin;
                                out AttributeDecl: TDtdAttributeDecl): Boolean; virtual;

    property AttributeDecls: TDtdNamedObjectMap read FAttributeDeclarations;
  end;


  TDtdAttributeDecl = class(TDtdObject)
  private
    FAttrType: TXmlDataType;
    FDefaultValue: WideString;
    FConstraintType: TDomAttrValueConstraint;
    FEnumeration: TUtilsWideStringList;
    FOrigin: TDtdOrigin;
    FOwnerCollection: TDtdAttDeclCollection;
  public
    constructor Create(const AOwnerCollection: TDtdAttDeclCollection;
                       const AAttrName,
                             aDefaultValue: WideString;
                       const AEnumeration: TUtilsWideStringList;
                       const AAttrType: TXmlDataType;
                       const AConstraintType: TDomAttrValueConstraint;
                       const AOrigin: TDtdOrigin);
    destructor Destroy; override;

    property AttrType: TXmlDataType read FAttrType;
    property ConstraintType: TDomAttrValueConstraint read FConstraintType;
    property DefaultValue: WideString read FDefaultValue;
    property Enumeration: TUtilsWideStringList read FEnumeration;
    property Origin: TDtdOrigin read FOrigin;
    property OwnerCollection: TDtdAttDeclCollection read FOwnerCollection;
  end;

  TDtdElementDecl = class(TDtdObject)
  private
    FOrigin: TDtdOrigin;
  protected
    FAllowedChildTypes: set of TDtdContentModelType;
    FContentModel: TDtdContentModel;
    FContentType: TDtdContentType;
    FCreatedContentModels: TDtdObjectList;
  public
    constructor Create(const AOwner: TDtdModel;
                       const AName: WideString;
                       const AContentType: TDtdContentType;
                       const AOrigin: TDtdOrigin);
    destructor Destroy; override;
    procedure Clear; virtual;
    function CreateContentModel(const Name: WideString;
                                const ContentModelType: TDtdContentModelType): TDtdContentModel; virtual;
    procedure FreeAndNilContentModel(var CM: TDtdContentModel); virtual;
    function ReplaceContentModel(const NewContentModel: TDtdContentModel): TDtdContentModel; virtual;

    property ContentModel: TDtdContentModel read FContentModel;
    property ContentType: TDtdContentType read FContentType;
    property CreatedContentModels: TDtdObjectList read FCreatedContentModels;
    property Origin: TDtdOrigin read FOrigin;
  end;

  TDtdEntityDecl = class(TDtdObject)
  private
    FBaseUri: WideString;
    FEntityRefs: TUtilsWideStringList;
    FNotationName: WideString;
    FOrigin: TDtdOrigin;
    FPublicId: WideString;
    FReplacementText: WideString;
    FSystemId: WideString;
    FIsResolved: Boolean;
    function GetEntityType: TDtdEntityType;
    procedure SetReplacementText(const S: WideString);
  protected
    function CheckNoRecursion_2(const AncestorEntities: TUtilsWideStringList): Boolean; virtual;
    function GetIsParsedEntity: Boolean; virtual;
  public
    constructor Create(const AOwner: TDtdModel;
                       const AName,
                             AReplacementText,
                             APublicId,
                             ASystemId,
                             ANotationName,
                             ABaseUri: WideString;
                       const AOrigin: TDtdOrigin);
    destructor Destroy; override;
    function CheckNoRecursion: Boolean; virtual;
    function ResolveReplacementText(const ResolveEntityProc: TDomResolveEntityProc): TXmlErrorType; virtual;

    property BaseUri: WideString read FBaseUri;
    property EntityRefs: TUtilsWideStringList read FEntityRefs;
    property EntityType: TDtdEntityType read GetEntityType;
    property IsParsedEntity: Boolean read GetIsParsedEntity;
    property NotationName: WideString read FNotationName;
    property Origin: TDtdOrigin read FOrigin;
    property PublicId: WideString read FPublicId;
    property ReplacementText: WideString read FReplacementText;
    property SystemId: WideString read FSystemId;
    property IsResolved: Boolean read FIsResolved;
  end;

  TDtdNotationDecl = class(TDtdObject)
  private
    FOrigin: TDtdOrigin;
    FPublicId: WideString;
    FSystemId: WideString;
  public
    constructor Create(const AOwner: TDtdModel;
                       const AName,
                             APublicId,
                             ASystemId: WideString;
                       const AOrigin: TDtdOrigin);

    property Origin: TDtdOrigin read FOrigin;
    property PublicId: WideString read FPublicId;
    property SystemId: WideString read FSystemId;
  end;

  TDtdModel = class
  private
    FExtSubsetSysId: WideString;
    FIntSubsetSysId: WideString;
    FLastKey: Int64;
    FPEsInIntSubset: Boolean;
    FPreparationStatus: TDomPreparationStatus;
    FSetDefaults: Boolean;            // True during SetDefaults.
    function GetNewKey: Int64;
  protected
    FAttDeclCollections: TDtdNamedObjectMap;
    FElementDeclarations: TDtdNamedObjectMap;
    FEntityDeclarations: TDtdNamedObjectMap;
    FNotationDeclarations: TDtdNamedObjectMap;
    procedure ClearMaps; virtual;
    procedure SetDefaults;
    procedure SetPreparationStatus(const Value: TDomPreparationStatus); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; virtual;
    function FindAttDeclCollection(const Name: WideString): TDtdAttDeclCollection; virtual;
    function FindAttributeDecl(const ElementName,
                                     AttributeName: WideString): TDtdAttributeDecl; virtual;
    function FindElementDecl(const Name: WideString): TDtdElementDecl; virtual;
    function FindEntityDecl(const Name: WideString): TDtdEntityDecl; virtual;
    function FindNotationDecl(const Name: WideString): TDtdNotationDecl; virtual;
    function RemoveAttributeDecl(const ElementName,
                                         AttributeName: WideString): Boolean; virtual;
    function RemoveElementDecl(const Name: WideString): Boolean; virtual;
    function RemoveEntityDecl(const Name: WideString): Boolean; virtual;
    function RemoveNotationDecl(const Name: WideString): Boolean; virtual;
    function SetAttributeDecl(const ElementName,
                                    AttrName,
                                    AttrValue: WideString;
                              const Enumeration: TUtilsWideStringList;
                              const AttrType: TXmlDataType;
                              const ConstraintType: TDomAttrValueConstraint;
                              const Origin: TDtdOrigin;
                                out AttributeDecl: TDtdAttributeDecl): Boolean; virtual;
    function SetElementDecl(const Name: WideString;
                            const ContentType: TDtdContentType;
                            const Origin: TDtdOrigin;
                              out ElementDecl: TDtdElementDecl): Boolean; virtual;
    function SetEntityDecl(const Name,
                                 ReplacementText,
                                 PublicId,
                                 SystemId,
                                 NotationName,
                                 BaseUri: WideString;
                           const Origin: TDtdOrigin;
                             out EntityDecl: TDtdEntityDecl): Boolean; virtual;
    function SetNotationDecl(const Name,
                                   PublicId,
                                   SystemId: WideString;
                             const Origin: TDtdOrigin;
                               out NotationDecl: TDtdNotationDecl): Boolean; virtual;

    // Declaration collections and maps
    property AttDeclCollections: TDtdNamedObjectMap read FAttDeclCollections;
    property ElementDecls: TDtdNamedObjectMap read FElementDeclarations;
    property EntityDecls: TDtdNamedObjectMap read FEntityDeclarations;
    property NotationDecls: TDtdNamedObjectMap read FNotationDeclarations;

    property ExtSubsetSysId: WideString read FExtSubsetSysId write FExtSubsetSysId;
    property IntSubsetSysId: WideString read FIntSubsetSysId write FIntSubsetSysId;
    property PEsInIntSubset: Boolean read FPEsInIntSubset write FPEsInIntSubset default False;
    property PreparationStatus: TDomPreparationStatus read FPreparationStatus write SetPreparationStatus default PS_UNPREPARED;
  end;

// Views

  TDomAbstractView = class
  protected
    FDocument: TDomCustomDocument;
  public
    property Document: TDomCustomDocument read FDocument;
  end;

  TDomStyleSheet = class
  private
    function GetStyleSheetType: WideString; virtual; abstract;
    function GetDisabled: Boolean; virtual; abstract;
    procedure SetDisabled(const Value: Boolean); virtual; abstract;
    function GetOwnerNode: TDomNode; virtual; abstract;
    function GetParentStyleSheet: TDomStyleSheet; virtual; abstract;
    function GetHref: WideString; virtual; abstract;
    function GetTitle: WideString; virtual; abstract;
    function GetMedia: TDomMediaList; virtual; abstract;
  public
    property StyleSheetType: WideString read GetStyleSheetType;
    property Disabled: Boolean read GetDisabled write SetDisabled;
    property OwnerNode: TDomNode read GetOwnerNode;
    property ParentStyleSheet: TDomStyleSheet read GetParentStyleSheet;
    property Href: WideString read GetHref;
    property Title: WideString read GetTitle;
    property Media: TDomMediaList read GetMedia;
  end;

  TDomMediaList = class
  private
    function GetCssText: WideString; virtual; abstract;
    procedure SetCssText(const Value: WideString); virtual; abstract;
    function GetLength: Integer; virtual; abstract;
  public
    function Item(const Index: Integer): TDomStyleSheet; virtual; abstract;
    procedure Delete(const OldMedium: WideString); virtual; abstract;
    procedure Append(const NewMedium: WideString); virtual; abstract;
    property Length: Integer read GetLength;
    property CssText: WideString read GetCssText write SetCssText;
  end;

  TDomStyleSheetList = class
  private
    function GetLength: Integer; virtual; abstract;
  public
    function Item(const Index: Integer): TDomStyleSheet; virtual; abstract;
    property Length: Integer read GetLength;
  end;

  TDomDocumentStyle = class
  private
    function GetStyleSheets: TDomStyleSheetList; virtual; abstract;
  public
    property StyleSheets: TDomStyleSheetList read GetStyleSheets;
  end;

// XML Source Modeling

  TXmlSourceCode = class(TList)
  private
    procedure CalculatePieceOffset(const StartItem: Integer);
    function  GetNameOfFirstTag: WideString;
    function  GetText: WideString;
  public
    function  Add(Item: Pointer): Integer;
    procedure Clear; override;
    procedure ClearAndFree; virtual;
    procedure Delete(Index: Integer);
    procedure Exchange(Index1, Index2: Integer);
    function  GetPieceAtPos(Pos: Integer): TXmlSourceCodePiece;
    procedure Insert(Index: Integer; Item: Pointer);
    procedure Move(CurIndex, NewIndex: Integer);
    procedure Pack;
    function  Remove(Item: Pointer): Integer;
    procedure Sort(Compare: TListSortCompare);
    property  NameOfFirstTag: WideString read GetNameOfFirstTag;
    property  Text: WideString read GetText;
  end;

  TXmlSourceCodePiece = class
  private
    FPieceType: TDomPieceType;
    FText: WideString;
    FOffset: Integer;
    FOwner: TXmlSourceCode;
  public
    constructor Create(const pt: TDomPieceType); virtual;
    property PieceType: TDomPieceType read FPieceType;
    property Text: WideString read FText write FText;
    property Offset: Integer read FOffset;
    property OwnerSourceCode: TXmlSourceCode read FOwner;
  end;


// Parser

  TCustomResourceResolver = class(TDomBaseComponent)
  public
    function ResolveResource(const ABaseURI: WideString;
                               var PublicId,
                                   SystemId: WideString): TStream; virtual; abstract;
  end;

  TStandardResourceResolver = class(TCustomResourceResolver)
  private
    FOnResolveResource: TDomResolveResourceEvent;
  protected
    function AcquireStreamFromUri(const Uri: WideString): TStream; virtual;
  public
    function ResolveResource(const ABaseURI: WideString;
                               var PublicId,
                                   SystemId: WideString): TStream; override;
  published
    property OnResolveResource: TDomResolveResourceEvent read FOnResolveResource write FOnResolveResource;
  end;

  TDomXMLDeclType = ( DT_XML_DECLARATION,
                      DT_TEXT_DECLARATION,
                      DT_XML_OR_TEXT_DECLARATION,
                      DT_UNSPECIFIED );

  TXmlSimpleInputSource = class(TUtilsUCS4Reader)
  private
    FPublicId: WideString;
    FSystemId: WideString;
  protected
    function GetInputEncoding: WideString; virtual;
  public
    constructor Create(const Stream: TStream;
                       const APublicId,
                             ASystemId: WideString;
                       const ABufSize: Integer;
                       const ACodecClass: TUnicodeCodecClass;
                       const InitialByteCount,
                             InitialCharCount,
                             InitialRegularCharsInLine,
                             InitialTabsInLine,
                             InitialLine: Int64;
                             ReadLFOption: TCodecReadLFOption = lrNormalize);
    property InputEncoding: WideString read GetInputEncoding;
    property PublicId: WideString read FPublicId;
    property SystemId: WideString read FSystemId;
  end;

  TXmlInputSource = class(TXmlSimpleInputSource)
  private
    FDeclType: TDomXMLDeclType;
    FHasMalformedDecl: Boolean;
    FXmlEncoding: WideString;
    FXmlStandalone: TDomStandalone;
    FXmlVersion: WideString;
    function EvaluateXmlOrTextDecl(out DeclType: TDomXMLDeclType;
                                   out Version,
                                       EncName: WideString;
                                   out Standalone: TDomStandalone): Boolean;
  public
    constructor Create(const Stream: TStream;
                       const APublicId,
                             ASystemId: WideString;
                       const ABufSize: Integer;
                       const ACodecClass: TUnicodeCodecClass;
                       const InclDecl: Boolean;
                       const InitialByteCount,
                             InitialCharCount,
                             InitialRegularCharsInLine,
                             InitialTabsInLine,
                             InitialLine: Int64;
                             ReadLFOption: TCodecReadLFOption = lrNormalize);

    property BufSize;
    property DeclType: TDomXMLDeclType read FDeclType;
    property HasMalformedDecl: Boolean read FHasMalformedDecl;
    property XmlEncoding: WideString read FXmlEncoding;
    property XmlStandalone: TDomStandalone read FXmlStandalone;
    property XmlVersion: WideString read FXmlVersion;
  end;

  TXmlCustomTokenizer = class(TUtilsNoRefCount, IDomLocator)
  protected
    FClue: WideString;
    FErrorType: TXmlErrorType;
    FInputSource: TXmlSimpleInputSource;
    FTokenEnd: TUtilsUCS4CharData;
    FTokenStart: TUtilsUCS4CharData;
    FTokenValue: TUtilsCustomWideStr;
    function GetTokenValue: WideString; virtual;

    { IDomLocator interface methods: }
    function GetEndByteNumber: Int64; virtual; stdcall;
    function GetEndCharNumber: Int64; virtual; stdcall;
    function GetEndColumnNumber: Int64; virtual; stdcall;
    function GetEndLineNumber: Int64; virtual; stdcall;
    function GetEndTabsInLine: Int64; virtual; stdcall;
    function GetRelatedDtdObject: TDtdObject; virtual; stdcall;
    function GetRelatedNode: TDomNode; virtual; stdcall;
    function GetStartByteNumber: Int64; virtual; stdcall;
    function GetStartCharNumber: Int64; virtual; stdcall;
    function GetStartColumnNumber: Int64; virtual; stdcall;
    function GetStartLineNumber: Int64; virtual; stdcall;
    function GetStartTabsInLine: Int64; virtual; stdcall;
    function GetUri: WideString; virtual; stdcall;
  public
    constructor Create(const InputSource: TXmlSimpleInputSource);
    destructor Destroy; override;
    procedure Next; virtual; abstract;

    property Clue: WideString read FClue;
    property ErrorType: TXmlErrorType read FErrorType;
    property TokenValue: WideString read GetTokenValue;
  end;

  TXmlDocTokenType = (
    XML_CDATA_TOKEN,
    XML_CHAR_REF_DEC_TOKEN,
    XML_CHAR_REF_HEX_TOKEN,
    XML_COMMENT_TOKEN,
    XML_DOCTYPE_TOKEN,
    XML_EMPTY_ELEMENT_TAG_TOKEN,
    XML_END_OF_SOURCE_TOKEN,
    XML_END_TAG_TOKEN,
    XML_ENTITY_REF_TOKEN,
    XML_PCDATA_TOKEN,
    XML_PI_TOKEN,
    XML_START_OF_SOURCE_TOKEN,
    XML_START_TAG_TOKEN
  );

  TXmlDocTokenizer = class(TXmlCustomTokenizer)
  protected
    FTokenType: TXmlDocTokenType;
  public
    constructor Create(const InputSource: TXmlSimpleInputSource);
    procedure Next; override;

    property TokenType: TXmlDocTokenType read FTokenType;
  end;

  TXmlDtdDetailTokenType = (
    DTD_DETAIL_ATTLIST_DECL_START_TOKEN,
    DTD_DETAIL_COMMENT_TOKEN,
    DTD_DETAIL_COND_SECT_END_TOKEN,
    DTD_DETAIL_COND_SECT_OPENER_TOKEN,
    DTD_DETAIL_COND_SECT_START_TOKEN,
    DTD_DETAIL_DECL_END_TOKEN,
    DTD_DETAIL_ELEMENT_DECL_START_TOKEN,
    DTD_DETAIL_END_OF_SOURCE_TOKEN,
    DTD_DETAIL_ENTITY_DECL_START_TOKEN,
    DTD_DETAIL_INVALID_MARKUP_TOKEN,
    DTD_DETAIL_KEYWORD_TOKEN,
    DTD_DETAIL_NOTATION_DECL_START_TOKEN,
    DTD_DETAIL_OPERATOR_TOKEN,
    DTD_DETAIL_PARAMETER_ENTITY_REF_TOKEN,
    DTD_DETAIL_PI_CONTENT_TOKEN,
    DTD_DETAIL_PI_TARGET_TOKEN,
    DTD_DETAIL_QUOTED_STRING_TOKEN,
    DTD_DETAIL_START_OF_SOURCE_TOKEN,
    DTD_DETAIL_UNQUOTED_STRING_TOKEN,
    DTD_DETAIL_WHITESPACE_TOKEN
  );

  TXmlDtdDetailTokenizer = class(TXmlCustomTokenizer)
  private
    FIsPERefInDeclSep: Boolean;
    FInPI: Boolean;  // Internally used to indicate that the Tokenizer is processing a Processing Instruction.
  protected
    FLastTokenType: TXmlDtdDetailTokenType;
    FTokenType: TXmlDtdDetailTokenType;
  public
    constructor Create(const InputSource: TXmlSimpleInputSource;
                       const AIsPERefInDeclSep: Boolean);
    procedure Next; override;
    procedure NextEndOfIgnoredCondSect; virtual;

    property IsPERefInDeclSep: Boolean read FIsPERefInDeclSep;
    property TokenType: TXmlDtdDetailTokenType read FTokenType;
  end;

  TDomPERepository = class;

  TXmlPERefTreatment = (petResolve, petResolveInDeclSep, petResolveInDeclSepSkipExt);

  TXmlDtdDetailPETokenizer = class(TUtilsNoRefCount, IDomLocator)
  private
    FBufSize: Integer;
    FErrorType: TXmlErrorType;
    FInputSourceStack: TObjectStack;
    FPENameStack: TUtilsWideStringList;
    FPERefTreatment: TXmlPERefTreatment;
    FStreamStack: TObjectStack;
    FTokenizerStack: TObjectStack;

    FOnResolveParameterEntity: TDomResolveEntityEvent;

    procedure CreateInternalInputSource(const Stream: TStream;
                                        const PEName,
                                              PubId,
                                              SysId: WideString;
                                        const CodecClass: TUnicodeCodecClass;
                                        const IsPERefInDeclSep: Boolean);
    procedure CreateInternalStream(const S,
                                         PEName,
                                         PubId,
                                         SysId: WideString;
                                   const IsPERefInDeclSep: Boolean);
    procedure CreateInternalTokenizer(const InputSource: TXmlSimpleInputSource;
                                      const PEName: WideString;
                                      const IsPERefInDeclSep: Boolean);
    procedure DestroyInternalTokenizer;
    function GetClue: WideString;
    function GetCurrentPEName: WideString;
    function GetErrorType: TXmlErrorType;
    function GetInternalTokenizer: TXmlDtdDetailTokenizer;
    function GetIsPERefInDeclSep: Boolean;
    function GetTokenType: TXmlDtdDetailTokenType;
    function GetTokenValue: WideString;
    procedure SetPERefTreatment(const Value: TXmlPERefTreatment);
  protected
    FIsInMarkup: Boolean;
    procedure DoResolveParameterEntity(const EntityName: WideString;
                                         out EntityValue,
                                             PubId,
                                             SysId: WideString;
                                         out Error: TXmlErrorType);
    function GetIsProcessingPE: Boolean; virtual;

    { IDomLocator interface methods: }
    function GetEndByteNumber: Int64; virtual; stdcall;
    function GetEndCharNumber: Int64; virtual; stdcall;
    function GetEndColumnNumber: Int64; virtual; stdcall;
    function GetEndLineNumber: Int64; virtual; stdcall;
    function GetEndTabsInLine: Int64; virtual; stdcall;
    function GetRelatedDtdObject: TDtdObject; virtual; stdcall;
    function GetRelatedNode: TDomNode; virtual; stdcall;
    function GetStartByteNumber: Int64; virtual; stdcall;
    function GetStartCharNumber: Int64; virtual; stdcall;
    function GetStartColumnNumber: Int64; virtual; stdcall;
    function GetStartLineNumber: Int64; virtual; stdcall;
    function GetStartTabsInLine: Int64; virtual; stdcall;
    function GetUri: WideString; virtual; stdcall;

    property InternalTokenizer: TXmlDtdDetailTokenizer read GetInternalTokenizer;
  public
    constructor Create(const AInputSource: TXmlSimpleInputSource;
                       const AIsPERefInDeclSep: Boolean);
    destructor Destroy; override;
    procedure Next; virtual;
    procedure NextEndOfIgnoredCondSect; virtual;

    property Clue: WideString read GetClue;
    property CurrentPEName: WideString read GetCurrentPEName;
    property ErrorType: TXmlErrorType read GetErrorType;
    property IsInMarkup: Boolean read FIsInMarkup;
    property IsPERefInDeclSep: Boolean read GetIsPERefInDeclSep;
    property IsProcessingPE: Boolean read GetIsProcessingPE;
    property PERefTreatment: TXmlPERefTreatment read FPERefTreatment write SetPERefTreatment default petResolve;
    property TokenType: TXmlDtdDetailTokenType read GetTokenType;
    property TokenValue: WideString read GetTokenValue;

    property OnResolveParameterEntity: TDomResolveEntityEvent read FOnResolveParameterEntity write FOnResolveParameterEntity;
  end;

  TXmlSignal = class;
  TXmlCommentSignal = class;
  TXmlElementTypeDeclarationSignal = class;
  TXmlEntityDeclarationSignal = class;
  TXmlExternalPEReferenceSignal = class;
  TXmlNotationDeclarationSignal = class;
  TXmlParameterEntityDeclarationSignal = class;
  TXmlProcessingInstructionSignal = class;

  TXmlExtSubsetTokenizer = class;

  TXmlDtdAbstractTokenType = (
    DTD_ABSTRACT_ATTLIST_DECL_TOKEN,
    DTD_ABSTRACT_COMMENT_TOKEN,
    DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN,
    DTD_ABSTRACT_ELEMENT_DECL_TOKEN,
    DTD_ABSTRACT_END_OF_SOURCE_TOKEN,
    DTD_ABSTRACT_ENTITY_DECL_TOKEN,
    DTD_ABSTRACT_EXT_PARAMETER_ENTITY_REF_TOKEN,
    DTD_ABSTRACT_IGNORABLE_WHITESPACE_TOKEN,
    DTD_ABSTRACT_INVALID_MARKUP_TOKEN,
    DTD_ABSTRACT_NOTATION_DECL_TOKEN,
    DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN,
    DTD_ABSTRACT_PI_TOKEN,
    DTD_ABSTRACT_START_OF_SOURCE_TOKEN
  );

  TXmlCustomSubsetTokenizer = class(TUtilsNoRefCount, IDomLocator)
  private
    function FindNextAttDef(    Decl: WideString;
                            out AttType: TXmlDataType;
                            out Constraint: TDomAttrValueConstraint;
                            out AttName,
                                Enumeration,
                                DefaultValue,
                                Rest: WideString): Boolean;
  protected
    FAllowConditionalSections: Boolean;
    FAttDeclElementType: WideString;
    FClue: WideString;
    FCondSectBracketPEName: TUtilsWideStringList;
    FCondSectStartPEName: TUtilsWideStringList;
    FCurrentSignal: TXmlSignal;
    FEntityDeclBaseUri: WideString;
    FErrorType: TXmlErrorType;
    FPERepository: TDomPERepository;
    FTokenType: TXmlDtdAbstractTokenType;
    FOnPEReference: TDomLocationEvent;
    FOnProcessingAttListDecl: TDomWideStringLocationEvent;
    FOpeningBracketPEName: TUtilsWideStringList;
    FPendingAttrDefs: WideString;
    FXmlDtdDetailPETokenizer: TXmlDtdDetailPETokenizer;
    function CreateCommentSignal(const Data: WideString): TXmlCommentSignal;
    function CreateElementDeclSignal(const ElementName,
                                           Data: WideString;
                                     const IsDeclaredInPE: Boolean): TXmlElementTypeDeclarationSignal;
    function CreateEntityDeclSignal(const EntityName,
                                          EntityValue,
                                          PublicId,
                                          SystemId,
                                          NotationName,
                                          BaseUri: WideString;
                                    const IsDeclaredInPE: Boolean): TXmlEntityDeclarationSignal;
    function CreateExtPERefSignal(const ParameterEntityReference: WideString): TXmlExternalPEReferenceSignal;
    function CreateParameterEntityDeclSignal(const EntityName,
                                                   EntityValue,
                                                   PublicId,
                                                   SystemId,
                                                   BaseUri: WideString): TXmlParameterEntityDeclarationSignal;
    function CreatePISignal(const Target,
                                  Data: WideString): TXmlProcessingInstructionSignal;
    function CreateNotationDeclSignal(const NotationName,
                                            PubidLiteral,
                                            SystemLiteral: WideString;
                                      const IsDeclaredInPE: Boolean): TXmlNotationDeclarationSignal;
    procedure DoPEReference;
    procedure DoProcessingAttListDecl(const ElementType: WideString);
    function GetAllowPEsInMarkup: Boolean; virtual;
    function GetClue: WideString; virtual;
    function GetEntityDeclBaseUri: WideString; virtual;
    function GetErrorType: TXmlErrorType; virtual;
    function GetIsProcessingPE: Boolean; virtual;
    function GetSystemId: WideString; virtual;
    function GetTokenType: TXmlDtdAbstractTokenType ; virtual;
    function IncludePERefsInLiteral(const S: WideString;
                                   out ErrType: TXmlErrorType): WideString;
    function ProcessPendingAttrDef: Boolean;
    procedure ResolveParameterEntityEventHandler(      Sender: TObject;
                                                 const EntityName: WideString;
                                                   var EntityValue,
                                                       PubId,
                                                       SysId: WideString;
                                                   var Error: TXmlErrorType);  virtual; abstract;

    { IDomLocator interface methods: }
    function GetEndByteNumber: Int64; virtual; stdcall;
    function GetEndCharNumber: Int64; virtual; stdcall;
    function GetEndColumnNumber: Int64; virtual; stdcall;
    function GetEndLineNumber: Int64; virtual; stdcall;
    function GetEndTabsInLine: Int64; virtual; stdcall;
    function GetRelatedDtdObject: TDtdObject; virtual; stdcall;
    function GetRelatedNode: TDomNode; virtual; stdcall;
    function GetStartByteNumber: Int64; virtual; stdcall;
    function GetStartCharNumber: Int64; virtual; stdcall;
    function GetStartColumnNumber: Int64; virtual; stdcall;
    function GetStartLineNumber: Int64; virtual; stdcall;
    function GetStartTabsInLine: Int64; virtual; stdcall;
    function GetUri: WideString; virtual; stdcall;
  public
    constructor Create(const AInputSource: TXmlSimpleInputSource;
                       const APERepository: TDomPERepository);
    destructor Destroy; override;
    procedure Next; virtual;

    property AllowPEsInMarkup: Boolean read GetAllowPEsInMarkup;
    property Clue: WideString read GetClue;
    property CurrentSignal: TXmlSignal read FCurrentSignal;
    property EntityDeclBaseUri: WideString read GetEntityDeclBaseUri;
    property ErrorType: TXmlErrorType read GetErrorType;
    property IsProcessingPE: Boolean read GetIsProcessingPE;
    property PERepository: TDomPERepository read FPERepository;
    property SystemId: WideString read GetSystemId;
    property TokenType: TXmlDtdAbstractTokenType read GetTokenType;

    property OnPEReference: TDomLocationEvent read FOnPEReference write FOnPEReference;
    property OnProcessingAttListDecl: TDomWideStringLocationEvent read FOnProcessingAttListDecl write FOnProcessingAttListDecl;
  end;

  TXmlExtSubsetTokenizer = class(TXmlCustomSubsetTokenizer)
  protected
    procedure ResolveParameterEntityEventHandler(      Sender: TObject;
                                                 const EntityName: WideString;
                                                   var EntityValue,
                                                       PubId,
                                                       SysId: WideString;
                                                   var Error: TXmlErrorType);  override;
  public
    constructor Create(const AInputSource: TXmlInputSource;
                       const APERepository: TDomPERepository);
  end;

  TXmlIntSubsetTokenizer = class(TXmlCustomSubsetTokenizer)
  protected
    function GetResolveExtPEs: Boolean; virtual;
    procedure ResolveParameterEntityEventHandler(      Sender: TObject;
                                                 const EntityName: WideString;
                                                   var EntityValue,
                                                       PubId,
                                                       SysId: WideString;
                                                   var Error: TXmlErrorType);  override;
    procedure SetResolveExtPEs(const Value: Boolean); virtual;
  public
    constructor Create(const AInputSource: TXmlSimpleInputSource;
                       const APERepository: TDomPERepository);

    property ResolveExtPEs: Boolean read GetResolveExtPEs write SetResolveExtPEs default True;
  end;

  TXmlElementCMTokenType = (
    DTD_ECM_ANY_KEYWORD_TOKEN,
    DTD_ECM_CLOSING_BRACKET_TOKEN,
    DTD_ECM_EMPTY_KEYWORD_TOKEN,
    DTD_ECM_END_OF_SOURCE_TOKEN,
    DTD_ECM_FREQUENCY_TOKEN,
    DTD_ECM_INVALID_MARKUP_TOKEN,
    DTD_ECM_NAME_TOKEN,
    DTD_ECM_OPENING_BRACKET_TOKEN,
    DTD_ECM_PCDATA_KEYWORD_TOKEN,
    DTD_ECM_SEPARATOR_TOKEN,
    DTD_ECM_START_OF_SOURCE_TOKEN
  );

  TXmlElementCMTokenizer = class
  protected
    FClue: WideString;
    FBracketFound: Boolean;
    FErrorType: TXmlErrorType;
    FUCS4Reader: TUtilsUCS4Reader;
    FStringStream: TUtilsWideStringStream;
    FTokenType: TXmlElementCMTokenType;
    FTokenValue: TUtilsCustomWideStr;
    function GetTokenValue: WideString; virtual;
  public
    constructor Create(const S: WideString);
    destructor Destroy; override;
    procedure Next; virtual;

    property Clue: WideString read FClue;
    property ErrorType: TXmlErrorType read FErrorType;
    property TokenType: TXmlElementCMTokenType read FTokenType;
    property TokenValue: WideString read GetTokenValue;
  end;

  TXmlDoctypeDeclTokenType = (
    DOCTYPE_END_OF_SOURCE_TOKEN,
    DOCTYPE_INTSUBSET_TOKEN,
    DOCTYPE_NAME_TOKEN,
    DOCTYPE_PUBID_TOKEN,
    DOCTYPE_START_OF_SOURCE_TOKEN,
    DOCTYPE_SYSID_TOKEN
  );

  TXmlDoctypeDeclTokenizer = class(TUtilsNoRefCount, IDomLocator)
  protected
    FClue: WideString;
    FErrorType: TXmlErrorType;
    FInputSource: TXmlSimpleInputSource;
    FStringStream: TUtilsWideStringStream;
    FTokenEnd: TUtilsUCS4CharData;
    FTokenStart: TUtilsUCS4CharData;
    FTokenType: TXmlDoctypeDeclTokenType;
    FTokenValue: TUtilsCustomWideStr;
    function GetTokenValue: WideString; virtual;

    { IDomLocator interface methods: }
    function GetEndByteNumber: Int64; virtual; stdcall;
    function GetEndCharNumber: Int64; virtual; stdcall;
    function GetEndColumnNumber: Int64; virtual; stdcall;
    function GetEndLineNumber: Int64; virtual; stdcall;
    function GetEndTabsInLine: Int64; virtual; stdcall;
    function GetRelatedDtdObject: TDtdObject; virtual; stdcall;
    function GetRelatedNode: TDomNode; virtual; stdcall;
    function GetStartByteNumber: Int64; virtual; stdcall;
    function GetStartCharNumber: Int64; virtual; stdcall;
    function GetStartColumnNumber: Int64; virtual; stdcall;
    function GetStartLineNumber: Int64; virtual; stdcall;
    function GetStartTabsInLine: Int64; virtual; stdcall;
    function GetUri: WideString; virtual; stdcall;
  public
    constructor Create(const S,
                             DocumentUri: WideString;
                             InitialByteCount,
                             InitialCharCount,
                             InitialRegularCharsInLine,
                             InitialTabsInLine,
                             InitialLine: Int64);
    destructor Destroy; override;
    procedure Next; virtual;

    property Clue: WideString read FClue;
    property ErrorType: TXmlErrorType read FErrorType;
    property TokenType: TXmlDoctypeDeclTokenType read FTokenType;
    property TokenValue: WideString read GetTokenValue;
  end;

  TXmlAttrValueTokenType = (
    ATTR_CHAR_REF,
    ATTR_END_OF_SOURCE_TOKEN,
    ATTR_ENTITY_REF,
    ATTR_START_OF_SOURCE_TOKEN,
    ATTR_TEXT
  );

  TXmlAttrValueTokenizer = class
  protected
    FErrorType: TXmlErrorType;
    FUCS4Reader: TUtilsUCS4Reader;
    FStringStream: TUtilsWideStringStream;
    FTokenType: TXmlAttrValueTokenType;
    FTokenValue: TUtilsCustomWideStr;
    function GetTokenValue: WideString; virtual;
  public
    constructor Create(const S: WideString; ReadLFOption: TCodecReadLFOption = lrNormalize);
    destructor Destroy; override;
    procedure Next; virtual;

    property ErrorType: TXmlErrorType read FErrorType;
    property TokenType: TXmlAttrValueTokenType read FTokenType;
    property TokenValue: WideString read GetTokenValue;
  end;

  TXmlOutputSource = class(TUtilsCustomOutputStream)
  private
    FCodec: TCustomUnicodeCodec;
  protected
    function GetCodecClass: TUnicodeCodecClass; virtual;
    function GetWriteLFOption: TCodecWriteLFOption; virtual;
    procedure SetCodecClass(const Value: TUnicodeCodecClass); virtual;
    procedure SetWriteLFOption(const Value: TCodecWriteLFOption); virtual;
    procedure WriteEventHandler(      Sender: TObject;
                                const Buf;
                                      Count: Longint); virtual;
  public
    constructor Create(const Stream: TStream;
                       const BufSize: Integer);
    destructor Destroy; override;
    procedure WriteUCS4Char(const C: UCS4Char;
                              out ByteCount: Integer); virtual;

    property BufSize;
    property CodecClass: TUnicodeCodecClass read GetCodecClass write SetCodecClass;  // The default is TUTF8Codec
    property WriteLFOption: TCodecWriteLFOption read GetWriteLFOption write SetWriteLFOption default lwCRLF;
  end;

  TXmlCustomParser      = class;
  TXmlToDomParser       = class;
  TXmlCustomReader      = class;
  TXmlStandardDocReader = class;
  TXmlStandardDtdReader = class;
  TXmlCustomHandler     = class;

  TXmlProcessingEvent = procedure(Sender: TObject;
                                  Signal: TXmlSignal;
                                  var Accept: Boolean) of object;

  TXmlPostProcessingEvent = procedure(Sender: TObject;
                                      Signal: TXmlSignal) of object;

  TDomPERepository = class
  private
    FOwner: TXmlCustomReader;
    FPEMap: TDomOwnerNamedNodeMap;
  protected
    procedure ResolveResourceAsWideString(const BaseURI: WideString;
                                          const PublicId,
                                                SystemId: WideString;
                                            out S: WideString;
                                            out Error: TXmlErrorType); virtual;
  public
    constructor Create(const AOwner: TXmlCustomReader);
    destructor Destroy; override;
    function Add(const Name,
                       Value: WideString): Boolean; overload;
    function Add(const Name,
                       BaseUri,
                       PubId,
                       SysId: WideString): Boolean; overload; 
    procedure Clear; virtual;
    function ResolvePE(const Name: WideString;
                       const AcceptExtEntity: Boolean;
                         out Value,
                             PubId,
                             SysId: WideString): TXmlErrorType; virtual;

    property OwnerReader: TXmlCustomReader read FOwner;
  end;

  TDomPEInfoObject = class(TDomCustomNode)
  private
    FBaseUri: WideString;
    FEntityType: TDomEntityType;
    FUpdateAttempted: Boolean;
    FUpdateError: TXmlErrorType;
    FLiteralValue: WideString;
    FNodeName: WideString;
    FOwnerRepository: TDomPERepository;
    FPublicId: WideString;
    FSystemId: WideString;
  protected
    function GetNodeName: WideString; override;
  public
    constructor Create(const AOwner: TDomPERepository;
                       const EntityName,
                             LitValue: WideString);
    constructor CreateExtParsed(const AOwner: TDomPERepository;
                                const EntityName,
                                      ABaseUri,
                                      PubId,
                                      SysId: WideString);
    function EntityURI: WideString;
    procedure Update;

    property BaseUri: WideString read FBaseUri;
    property EntityType: TDomEntityType read FEntityType;
    property LiteralValue: WideString read FLiteralValue;
    property OwnerRepository: TDomPERepository read FOwnerRepository;
    property PublicId: WideString read FPublicId;
    property SystemId: WideString read FSystemId;
    property UpdateAttempted: Boolean read FUpdateAttempted;
    property UpdateError: TXmlErrorType read FUpdateError;
  end;

{ XML Fragments }

  TXmlSignalScope = set of ( ssDoc, ssDtd );

  TXmlSignal = class(TUtilsNoRefCount, IDomLocator)
  private
    FEndByteNumber:     Int64;
    FEndCharNumber:     Int64;
    FEndColumnNumber:   Int64;
    FEndLineNumber:     Int64;
    FEndTabsInLine:     Int64;
    FReader:            TXmlCustomReader;
    FRelatedDtdObject:  TDtdObject;
    FRelatedNode:       TDomNode;
    FStartByteNumber:   Int64;
    FStartCharNumber:   Int64;
    FStartColumnNumber: Int64;
    FStartLineNumber:   Int64;
    FStartTabsInLine:   Int64;
    FUri:               WideString;
  protected
    { IDomLocator interface methods: }
    function GetEndByteNumber: Int64; virtual; stdcall;
    function GetEndCharNumber: Int64; virtual; stdcall;
    function GetEndColumnNumber: Int64; virtual; stdcall;
    function GetEndLineNumber: Int64; virtual; stdcall;
    function GetEndTabsInLine: Int64; virtual; stdcall;
    function GetRelatedDtdObject: TDtdObject; virtual; stdcall;
    function GetRelatedNode: TDomNode; virtual; stdcall;
    function GetStartByteNumber: Int64; virtual; stdcall;
    function GetStartCharNumber: Int64; virtual; stdcall;
    function GetStartColumnNumber: Int64; virtual; stdcall;
    function GetStartLineNumber: Int64; virtual; stdcall;
    function GetStartTabsInLine: Int64; virtual; stdcall;
    function GetUri: WideString; virtual; stdcall;
  public
    constructor Create(const AReader: TXmlCustomReader;
                       const AStartByteNumber,
                             AStartCharNumber,
                             AStartColumnNumber,
                             AStartLineNumber,
                             AStartTabsInLine,
                             AEndByteNumber,
                             AEndCharNumber,
                             AEndColumnNumber,
                             AEndLineNumber,
                             AEndTabsInLine: Int64;
                       const AUri: WideString;
                       const ARelatedDtdObject: TDtdObject;
                       const ARelatedNode: TDomNode); virtual;
    constructor CreateFromLocator(const AReader: TXmlCustomReader;
                                  const Location: IDomLocator); virtual;
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); virtual;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; virtual;
    function Scope: TXmlSignalScope; virtual; abstract;

    property Reader: TXmlCustomReader read FReader;

    { IDomLocator interface properties: }      
    property EndByteNumber: Int64 read GetEndByteNumber;
    property EndCharNumber: Int64 read GetEndCharNumber;
    property EndColumnNumber: Int64 read GetEndColumnNumber;
    property EndLineNumber: Int64 read GetEndLineNumber;
    property EndTabsInLine: Int64 read GetEndTabsInLine;
    property RelatedDtdObject: TDtdObject read GetRelatedDtdObject;
    property RelatedNode: TDomNode read GetRelatedNode;
    property StartByteNumber: Int64 read GetStartByteNumber;
    property StartCharNumber: Int64 read GetStartCharNumber;
    property StartColumnNumber: Int64 read GetStartColumnNumber;
    property StartLineNumber: Int64 read GetStartLineNumber;
    property StartTabsInLine: Int64 read GetStartTabsInLine;
    property Uri: WideString read GetUri;
  end;

  TXmlSignalClass = class of TXmlSignal;

  { Special XML Signals }

  TXmlCompletedSignal = class(TXmlSignal)
  public
    function Scope: TXmlSignalScope; override;
  end;

  TXmlAbortedSignal = class(TXmlSignal)
  public
    function Scope: TXmlSignalScope; override;
  end;

  { Non-DTD XML Signals }

  TXmlAttributeSignal = class(TXmlSignal)
  private
    FDataType: TXmlDataType;
    FName: WideString;
    FValue: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property DataType: TXmlDataType read FDataType write FDataType;
    property Name: WideString read FName write FName;
    property Value: WideString read FValue write FValue;
  end;

  TXmlCDATASignal = class(TXmlSignal)
  private
    FData: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property Data: WideString read FData write FData;
  end;

  TXmlDoctypeSignal = class(TXmlSignal)
  private
    FData: WideString;
    FDoctypeName: WideString;
    FIntSubsetByteNumber: Int64;
    FIntSubsetCharNumber: Int64;
    FIntSubsetStartColumn: Int64;
    FIntSubsetStartLine: Int64;
    FPublicId: WideString;
    FSystemId: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property Data: WideString read FData write FData;
    property DoctypeName: WideString read FDoctypeName write FDoctypeName;
    property IntSubsetStartByteNumber: Int64 read FIntSubsetByteNumber write FIntSubsetByteNumber;
    property IntSubsetStartCharNumber: Int64 read FIntSubsetCharNumber write FIntSubsetCharNumber;
    property IntSubsetStartColumn: Int64 read FIntSubsetStartColumn write FIntSubsetStartColumn;
    property IntSubsetStartLine: Int64 read FIntSubsetStartLine write FIntSubsetStartLine;
    property PublicId: WideString read FPublicId write FPublicId;
    property SystemId: WideString read FSystemId write FSystemId;
  end;

  TXmlEndElementSignal = class(TXmlSignal)
  private
    FTagName: WideString;
    FShortForm: Boolean;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property ShortForm: Boolean read FShortForm write FShortForm;
    property TagName: WideString read FTagName write FTagName;
  end;

  TXmlEndPrefixMappingSignal = class(TXmlSignal)
  private
    FPrefix: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property Prefix: WideString read FPrefix write FPrefix; 
  end;

  TXmlEntityRefSignal = class(TXmlSignal)
  private
    FEntityName: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property EntityName: WideString read FEntityName write FEntityName;
  end;

  TXmlPCDATASignal = class(TXmlSignal)
  private
    FCharRefGenerated: Boolean;
    FData: WideString;
  public
    constructor Create(const AReader: TXmlCustomReader;
                       const AStartByteNumber,
                             AStartCharNumber,
                             AStartColumnNumber,
                             AStartLineNumber,
                             AStartTabsInLine,
                             AEndByteNumber,
                             AEndCharNumber,
                             AEndColumnNumber,
                             AEndLineNumber,
                             AEndTabsInLine: Int64;
                       const AUri: WideString;
                       const ARelatedDtdObject: TDtdObject;
                       const ARelatedNode: TDomNode); override;
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property CharRefGenerated: Boolean read FCharRefGenerated write FCharRefGenerated default False;
    property Data: WideString read FData write FData;
  end;

  TXmlSkippedEntitySignal = class(TXmlSignal)
  private
    FEntityName: WideString;
  public
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property EntityName: WideString read FEntityName write FEntityName;
  end;

  TXmlStartDocumentSignal = class(TXmlSignal)
  private
    FEncodingName: WideString;
    FInputEncoding: WideString;
    FStandaloneDecl: TDomStandalone;
    FVersion: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property EncodingName: WideString read FEncodingName write FEncodingName;
    property InputEncoding: WideString read FInputEncoding write FInputEncoding;
    property StandaloneDecl: TDomStandalone read FStandaloneDecl write FStandaloneDecl;
    property Version: WideString read FVersion write FVersion;
  end;

  TXmlStartDocumentFragmentSignal = class(TXmlSignal)
  private
    FEncodingName: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property EncodingName: WideString read FEncodingName write FEncodingName;
  end;

  TXmlStartElementSignal = class(TXmlSignal)
  private
    FTagName: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property TagName: WideString read FTagName write FTagName;
  end;

  TXmlStartPrefixMappingSignal = class(TXmlSignal)
  private
    FPrefix: WideString;
    FUri: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property Prefix: WideString read FPrefix write FPrefix;
    property Uri: WideString read FUri write FUri;
  end;

  { Non-DTD as well as DTD XML Signal }

  TXmlCommentSignal = class(TXmlSignal)
  private
    FData: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property Data: WideString read FData write FData;
  end;

  TXmlProcessingInstructionSignal = class(TXmlSignal)
  private
    FData: WideString;
    FTarget: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property Data: WideString read FData write FData;
    property Target: WideString read FTarget write FTarget;
  end;

  { DTD XML Signals }

  TXmlAttributeDefinitionSignal = class(TXmlSignal)
  private
    FAttributeName: WideString;
    FAttributeType: TXmlDataType;
    FConstraint: TDomAttrValueConstraint;
    FDefaultValue: WideString;
    FEnumeration: TUtilsWideStringList;
    FElementName: WideString;
    FIsDeclaredInPE: Boolean;
    procedure SetEnumeration(const Value: TUtilsWideStringList);
  public
    constructor Create(const AReader: TXmlCustomReader;
                       const AStartByteNumber,
                             AStartCharNumber,
                             AStartColumnNumber,
                             AStartLineNumber,
                             AStartTabsInLine,
                             AEndByteNumber,
                             AEndCharNumber,
                             AEndColumnNumber,
                             AEndLineNumber,
                             AEndTabsInLine: Int64;
                       const AUri: WideString;
                       const ARelatedDtdObject: TDtdObject;
                       const ARelatedNode: TDomNode); override;
    destructor Destroy; override;
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property AttributeName: WideString read FAttributeName write FAttributeName;
    property AttributeType: TXmlDataType read FAttributeType write FAttributeType;
    property Constraint: TDomAttrValueConstraint read FConstraint write FConstraint;
    property DefaultValue: WideString read FDefaultValue write FDefaultValue;
    property ElementName: WideString read FElementName write FElementName;
    property Enumeration: TUtilsWideStringList read FEnumeration write SetEnumeration;
    property IsDeclaredInPE: Boolean read FIsDeclaredInPE write FIsDeclaredInPE;
  end;

  TXmlElementTypeDeclarationSignal = class(TXmlSignal)
  private
    FData: WideString;
    FElementName: WideString;
    FIsDeclaredInPE: Boolean;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property Data: WideString read FData write FData;
    property ElementName: WideString read FElementName write FElementName;
    property IsDeclaredInPE: Boolean read FIsDeclaredInPE write FIsDeclaredInPE;
  end;

  TXmlEntityDeclarationSignal = class(TXmlSignal)
  private
    FBaseUri: WideString;
    FEntityValue: WideString;
    FPublicId: WideString;
    FNotationName: WideString;
    FEntityName: WideString;
    FSystemId: WideString;
    FIsDeclaredInPE: Boolean;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property BaseUri: WideString read FBaseUri write FBaseUri;
    property EntityName: WideString read FEntityName write FEntityName;
    property EntityValue: WideString read FEntityValue write FEntityValue;
    property IsDeclaredInPE: Boolean read FIsDeclaredInPE write FIsDeclaredInPE;
    property NotationName: WideString read FNotationName write FNotationName;
    property PublicId: WideString read FPublicId write FPublicId;
    property SystemId: WideString read FSystemId write FSystemId;
  end;

  TXmlExternalPEReferenceSignal = class(TXmlSignal)
  private
    FParameterEntityName: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property ParameterEntityName: WideString read FParameterEntityName write FParameterEntityName;
  end;

  TXmlNotationDeclarationSignal = class(TXmlSignal)
  private
    FNotationName: WideString;
    FPublicId: WideString;
    FSystemId: WideString;
    FIsDeclaredInPE: Boolean;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property IsDeclaredInPE: Boolean read FIsDeclaredInPE write FIsDeclaredInPE;
    property NotationName: WideString read FNotationName write FNotationName;
    property PublicId: WideString read FPublicId write FPublicId;
    property SystemId: WideString read FSystemId write FSystemId;
  end;

  TXmlParameterEntityDeclarationSignal = class(TXmlSignal)
  private
    FBaseUri: WideString;
    FEntityName: WideString;
    FEntityValue: WideString;
    FPublicId: WideString;
    FSystemId: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property BaseUri: WideString read FBaseUri write FBaseUri;
    property EntityName: WideString read FEntityName write FEntityName;
    property EntityValue: WideString read FEntityValue write FEntityValue;
    property PublicId: WideString read FPublicId write FPublicId;
    property SystemId: WideString read FSystemId write FSystemId;
  end;

  TXmlPEReferenceFoundSignal = class(TXmlSignal)
  public
    function Scope: TXmlSignalScope; override;
  end;

  TXmlStartExtDtdSignal = class(TXmlSignal)
  private
    FEncodingName: WideString;
    FInputEncoding: WideString;
    FPublicId: WideString;
    FSystemId: WideString;
    FVersion: WideString;
  public
    procedure CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                  out Flaw,
                                      Clue: WideString); override;
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property EncodingName: WideString read FEncodingName write FEncodingName;
    property InputEncoding: WideString read FInputEncoding write FInputEncoding;
    property PublicId: WideString read FPublicId write FPublicId;
    property SystemId: WideString read FSystemId write FSystemId;
    property Version: WideString read FVersion write FVersion;
  end;

  TXmlStartIntDtdSignal = class(TXmlSignal)
  private
    FSystemId: WideString;
    FXmlStandalone: TDomStandalone;
  public
    function CloneSignal(const AReader: TXmlCustomReader): TXmlSignal; override;
    function Scope: TXmlSignalScope; override;

    property SystemId: WideString read FSystemId write FSystemId;
    property XmlStandalone: TDomStandalone read FXmlStandalone write FXmlStandalone;
  end;

{ XML Reader Components }

  TXmlCustomReader = class(TDomBaseComponent)
  private
    FDOMImpl: TDomImplementation;
    FNextHandler: TXmlCustomHandler;
    FOnError: TDomErrorNotifyEvent;
    procedure SetDomImpl(const Impl: TDomImplementation);
  protected
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure ResolveResourceAsWideString(const BaseURI: WideString;
                                          const PublicId,
                                                SystemId: WideString;
                                            out S: WideString;
                                            out Error: TXmlErrorType); virtual;
    procedure SendErrorNotification(const XmlErrorType: TXmlErrorType;
                                    const Location: IDomLocator;
                                    const Code,
                                          Clue: WideString); virtual;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DOMImpl: TDomImplementation read FDomImpl write SetDomImpl;
    property NextHandler: TXmlCustomHandler read FNextHandler write FNextHandler;

    property OnError: TDomErrorNotifyEvent read FOnError write FOnError;
  end;

  TXmlStandardDocReader = class (TXmlCustomReader)
  protected
    procedure Parse2(const XmlTokenizer: TXmlDocTokenizer); virtual;
    procedure SendAbortedSignal(const Locator: IDomLocator); virtual;
    procedure WriteAttribute(const Locator: IDomLocator;
                             const Name,
                                   Value: WideString); virtual;
    procedure WriteCDATA(const Locator: IDomLocator;
                         const Content: WideString); virtual;
    procedure WriteCharRefDec(const Locator: IDomLocator;
                              const Content: WideString); virtual;
    procedure WriteCharRefHex(const Locator: IDomLocator;
                              const Content: WideString); virtual;
    procedure WriteComment(const Locator: IDomLocator;
                           const Content: WideString); virtual;
    procedure WritePCDATA(const Locator: IDomLocator;
                          const Content: WideString); virtual;
    procedure WriteProcessingInstruction(const Locator: IDomLocator;
                                         const Content: WideString); virtual;
    procedure WriteStartDocument(const Locator: IDomLocator;
                                 const InputEnc,
                                       Version,
                                       EncName: WideString;
                                       SdDl: TDomStandalone); virtual;
    procedure WriteStartDocumentFragment(const Locator: IDomLocator;
                                         const EncName: WideString); virtual;
    procedure WriteStartElement(const Locator: IDomLocator;
                                const TagName: WideString); virtual;
    procedure WriteStartTag(const Locator: IDomLocator;
                                  Content: WideString;
                              out TagName: WideString); virtual;
    procedure WriteEndTag(const Locator: IDomLocator;
                          const Content: WideString); virtual;
    procedure WriteEmptyElementTag(const Locator: IDomLocator;
                                   const Content: WideString); virtual;
    procedure WriteEntityRef(const Locator: IDomLocator;
                             const Content: WideString); virtual;
    procedure WriteDoctype(const Locator: IDomLocator;
                           const Content: WideString); virtual;
    procedure WriteCompleted(const Locator: IDomLocator); virtual;
  public
    function  Parse(const InputSource: TXmlInputSource; CatchExceptions: Boolean = TRUE): Boolean; virtual;
    function  ParseFragment(const InputSource: TXmlSimpleInputSource): Boolean; virtual;
  end;

  TXmlStandardDtdReader = class (TXmlCustomReader)
  private
    FAttrListDeclNames: TUtilsWideStringList; // List to record the element types of
                                              // attribute-list declarations to detect
                                              // duplicates.
    FPERepository: TDomPERepository; // Collection of parameter entities.
    FXmlErrorDetected: Boolean;
    FXmlFatalErrorDetected: Boolean;
    procedure Parseloop(const Tokenizer: TXmlCustomSubsetTokenizer);
  protected
    procedure PEReferenceEventHandler(      Sender: TObject;
                                      const Locator: IDomLocator); virtual;
    procedure PEProcessingAttListDeclEventHandler(      Sender: TObject;
                                                  const ElementName: WideString;
                                                  const Locator: IDomLocator); virtual;
    procedure SendAbortedSignal(const Locator: IDomLocator); virtual;
    procedure SendErrorNotification(const XmlErrorType: TXmlErrorType;
                                    const Location: IDomLocator;
                                    const Code,
                                          Clue: WideString); override;
    procedure WriteCompleted(const Locator: IDomLocator); virtual;
    procedure WriteStartExtDtd(const Locator: IDomLocator;
                               const InputEnc,
                                     PubId,
                                     SysId,
                                     Version,
                                     EncName: WideString); virtual;
    procedure WriteStartIntDtd(const Locator: IDomLocator;
                               const SysId: WideString;
                               const Standalone: TDomStandalone); virtual;
    procedure WriteSignal(const Signal: TXmlSignal); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function  ParseExternalSubset(const InputSource: TXmlInputSource): Boolean; virtual;
    function  ParseInternalSubset(const InputSource: TXmlSimpleInputSource;
                                  const Standalone: TDomStandalone;
                                  const ResolveExtPEs: Boolean): Boolean; virtual;
    procedure Prepare; virtual;
  end;

  TXmlStandardDomReader = class (TXmlCustomReader)
  private
    FContextNode: TDomNode;
    FIgnoreUnspecified: Boolean;
  protected
    function GetContextNode: TDomNode; virtual;
    function GetSystemId: WideString; virtual;
    procedure Parseloop(const SourceNode: TDomNode); virtual;
    procedure SendAbortedSignal; virtual;
    procedure WriteAttribute(const ADataType: TXmlDataType;
                             const ANodeName,
                                   ANodeValue: WideString); virtual;
    procedure WriteCDATA(const Content: WideString); virtual;
    procedure WriteComment(const Content: WideString); virtual;
    procedure WriteDoctype(const DoctypeName,
                                 PublicId,
                                 SystemId,
                                 IntSubset: WideString); virtual;
    procedure WriteEndElement(const TagName: WideString); virtual;
    procedure WriteEndPrefixMapping(const Prefix: WideString); virtual;
    procedure WriteEntityRef(const EntityName: WideString); virtual;
    procedure WriteCompleted; virtual;
    procedure WritePCDATA(const Content: WideString;
                          const CharRefGenerated: Boolean); virtual;
    procedure WriteProcessingInstruction(const Targ,
                                               AttribSequence : WideString); virtual;
    procedure WriteStartDocument(const InputEnc,
                                       Version,
                                       EncName: WideString;
                                       SdDl: TDomStandalone); virtual;
    procedure WriteStartDocumentFragment(const EncName: WideString); virtual;
    procedure WriteStartElement(const TagName: WideString); virtual;
    procedure WriteStartPrefixMapping(const Prefix,
                                            Uri: WideString); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    function Parse(const SourceNode: TDomNode): Boolean; virtual;
    property ContextNode: TDomNode read GetContextNode;
  published
    property IgnoreUnspecified: Boolean read FIgnoreUnspecified write FIgnoreUnspecified;
  end;

{ XML Content Handler Components }

  TXmlCustomHandler = class(TDomBaseComponent)
  protected
    procedure SendErrorNotification(const Target: TXmlCustomReader;
                                    const XmlErrorType: TXmlErrorType;
                                    const Location: IDomLocator;
                                    const Code,
                                          Clue: WideString); virtual;
  public
    procedure processSignal(const Signal: TXmlSignal); virtual; abstract;
  end;

  TXmlStandardHandler = class(TXmlCustomHandler)
  protected
    FNextHandler: TXmlCustomHandler;
    FOnSignal: TXmlProcessingEvent;
    FOnSignaled: TXmlPostProcessingEvent;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
  public
    procedure ProcessSignal(const Signal: TXmlSignal); override;
  published
    property NextHandler: TXmlCustomHandler read FNextHandler write FNextHandler;

    property OnSignal: TXmlProcessingEvent read FOnSignal write FOnSignal;
    property OnSignaled: TXmlPostProcessingEvent read FOnSignaled write FOnSignaled;
  end;

  TXmlDistributor = class;

  TXmlHandlerItem = class(TCollectionItem)
  protected
    FXmlHandler: TXmlCustomHandler;
    function GetXmlHandler: TXmlCustomHandler;
    procedure SetXmlHandler(Value: TXmlCustomHandler);
  public
    procedure Assign(Source: TPersistent); override;
  published
    property XmlHandler: TXmlCustomHandler read GetXmlHandler write SetXmlHandler;
  end;

  TXmlHandlers = class(TCollection)
  private
    FDistributor: TXmlDistributor;
  protected
    function GetItem(Index: Integer): TXmlHandlerItem; virtual;
    procedure SetItem(Index: Integer; Value: TXmlHandlerItem); virtual;
    function GetOwner: TPersistent; override;
  public
    constructor Create(Distributor: TXmlDistributor);
    function Add: TXmlHandlerItem;
    procedure Assign(Source: TPersistent); override;
    function FindHandlerItem(AHandler: TXmlCustomHandler): TXmlHandlerItem;
    property Distributor: TXmlDistributor read FDistributor;
    property Items[Index: Integer]: TXmlHandlerItem read GetItem write SetItem; default;
  end;

  TXmlDistributor = class(TXmlCustomHandler)
  private
    FDisableCount: Integer;
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
  protected
    FNextHandlers: TXmlHandlers;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure SetNextHandlers(const Value: TXmlHandlers);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ProcessSignal(const Signal: TXmlSignal); override;
  published
    property NextHandlers: TXmlHandlers read FNextHandlers write SetNextHandlers;
  end;

  TXmlActivityStatus = ( asInactive, asDocActive, asDocFragActive, asExtDtdActive, asIntDtdActive );

  TXmlRootProcessingStatus = (rsBeforeRoot, rsInRoot, rsAfterRoot);

  TXmlWFTestHandler = class(TXmlCustomHandler)
  protected
    FActivityStatus: TXmlActivityStatus;
    FDoctypeFound: Boolean;
    FNextHandler: TXmlCustomHandler;
    FPrefixStack: TUtilsWideStringList;
    FRootProcessingStatus: TXmlRootProcessingStatus;
    FTagStack: TUtilsWideStringList;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure Reset; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ProcessSignal(const Signal: TXmlSignal); override;

    property ActivityStatus: TXmlActivityStatus read FActivityStatus;
  published
    property NextHandler: TXmlCustomHandler read FNextHandler write FNextHandler;
  end;

  TXmlNamespaceSignalGenerator = class(TXmlCustomHandler)
  protected
    FAttributeSignals: TObjectList;
    FElementName: WideString;
    FNextHandler: TXmlCustomHandler;
    FPrefixMapping: Boolean;
    FPrefixMappingStack: TList;
    FStartElementIsOpen: Boolean;
    FSuppressXmlns: Boolean;
    procedure ClearPrefixMappingStack; virtual;
    procedure CloseStartElement(const Sender: TXmlCustomReader;
                                const Locator: IDomLocator);
    procedure ProcessAttributeSignal(const Signal: TXmlAttributeSignal); virtual;
    procedure ProcessStartElementSignal(const Signal: TXmlStartElementSignal); virtual;
    procedure WriteEndPrefixMapping(const Sender: TXmlCustomReader;
                                    const Locator: IDomLocator); virtual;
    procedure WriteStartPrefixMapping(const Sender: TXmlCustomReader;
                                      const Locator: IDomLocator;
                                      const Prefix,
                                            Uri: WideString); virtual;
    procedure Reset; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ProcessSignal(const Signal: TXmlSignal); override;
  published
    property NextHandler: TXmlCustomHandler read FNextHandler write FNextHandler;
    property PrefixMapping: Boolean read FPrefixMapping write FPrefixMapping default True;
    property SuppressXmlns: Boolean read FSuppressXmlns write FSuppressXmlns default False;
  end;

  TXmlDomBuilder = class(TXmlCustomHandler)
  private
    FBuildIDList: Boolean;
    FDocTypeDeclTreatment: TDomDocTypeDeclTreatment;
    FKeepCDATASections: Boolean;
    FKeepComments: Boolean;
    FKeepEntityRefs: Boolean;
  protected
    FRefNode: TDomNode;
    FPrefixUriList: TUtilsNameValueList;
    procedure ProcessPCDATA(const Sender: TXmlCustomReader;
                            const Locator: IDomLocator;
                            const Data: WideString;
                            const CharRefGenerated: Boolean); virtual;
    procedure Reset; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ProcessSignal(const Signal: TXmlSignal); override;

    property ReferenceNode: TDomNode read FRefNode write FRefNode;
  published
    property BuildIDList: Boolean read FBuildIDList write FBuildIDList default True;
    property DocTypeDeclTreatment: TDomDocTypeDeclTreatment read FDocTypeDeclTreatment write FDocTypeDeclTreatment default dtCheckWellformedness;
    property KeepCDATASections: Boolean read FKeepCDATASections write FKeepCDATASections default True;
    property KeepComments: Boolean read FKeepComments write FKeepComments default True;
    property KeepEntityRefs: Boolean read FKeepEntityRefs write FKeepEntityRefs default True;
  end;

  TXmlDtdModelBuilder = class(TXmlCustomHandler)
  private
    FDtdModel: TDtdModel;
  protected
    FActivityStatus: TXmlActivityStatus;
    FDocStandalone: TDomStandalone;
    FIgnoreDeclarations: Boolean;
    procedure InsertMixedContent(const RefASElementDecl: TDtdElementDecl;
                                 const ContSpec: WideString); virtual;
    procedure InsertChildrenContent(const RefDtdObject: TDtdObject;
                                    const ContSpec: WideString); virtual;
    procedure SetDtdModel(const Value: TDtdModel); virtual;
    procedure Reset; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ProcessSignal(const Signal: TXmlSignal); override;

    property ActivityStatus: TXmlActivityStatus read FActivityStatus;
    property DtdModel: TDtdModel read FDtdModel write SetDtdModel;
  end;

  TXmlBOMOpt = set of ( bomUTF8, bomUTF16, bomUCS2 );

  TXmlStreamBuilder = class(TXmlCustomHandler)
  private
    FAttListDeclIsOpen: Boolean;  // Remark: If this variable is to be "published" the CheckAttListDeclarationOpen method must be modified accordingly!
    FStartElementIsOpen: Boolean;
    FByteCount: Integer;
    FCharacterCount: Integer;
    FColumnCount: Integer;
    FCurrentAttListDeclName: WideString;
    FCurrentEncoding: WideString;
    FDefaultEncoding: WideString;
    FDefaultCodecClass: TUnicodeCodecClass;
    FIncludeXmlDecl: Boolean;
    FLineFeedCount: Integer;
    FTabCount: Integer;
    FUseByteOrderMark: TXmlBOMOpt;
    FOutputSource: TXmlOutputSource;
    FOnAfterWrite: TDomSerializationEvent;
    FOnBeforeWrite: TDomSerializationEvent;
    procedure CheckAttListDeclarationClosed(const Sender: TXmlCustomReader;
                                            const Locator: IDomLocator);
    procedure CheckAttListDeclarationOpen(const Sender: TXmlCustomReader;
                                          const Locator: IDomLocator;
                                          const ElementName: WideString);
    procedure CheckStartElementClosed(const Sender: TXmlCustomReader;
                                      const Locator: IDomLocator;
                                      Signal: TXmlSignal);
    function GetCurrentCodecClass: TUnicodeCodecClass;
    procedure PutCurrentCodecClass(const Value: TUnicodeCodecClass);
    procedure ResetCurrentCodecClass;
    procedure SetDefaultEncoding(const Value: WideString);
    procedure SetOutputSource(const Value: TXmlOutputSource);
    procedure WriteWideString(const S: WideString;
                              const UseCharRefs: Boolean);

    procedure WriteAttributeDefinitionSignal(const Signal: TXmlAttributeDefinitionSignal);
    procedure WriteAttributeSignal(const Signal: TXmlAttributeSignal);
    procedure WriteCDATASignal(const Signal: TXmlCDataSignal);
    procedure WriteCommentSignal(const Signal: TXmlCommentSignal);
    procedure WriteDoctypeSignal(const Signal: TXmlDoctypeSignal);
    procedure WriteElementTypeDeclarationSignal(const Signal: TXmlElementTypeDeclarationSignal);
    procedure WriteEndElementSignal(const Signal: TXmlEndElementSignal);
    procedure WriteEntityDeclarationSignal(const Signal: TXmlEntityDeclarationSignal);
    procedure WriteEntityRefSignal(const Signal: TXmlEntityRefSignal);
    procedure WriteCompletedSignal(const Signal: TXmlCompletedSignal);
    procedure WriteNotationDeclarationSignal(const Signal: TXmlNotationDeclarationSignal);
    procedure WriteParameterEntityDeclarationSignal(const Signal: TXmlParameterEntityDeclarationSignal);
    procedure WritePCDATASignal(const Signal: TXmlPCDATASignal);
    procedure WriteProcessingInstructionSignal(const Signal: TXmlProcessingInstructionSignal);
    procedure WriteSkippedEntitySignal(const Signal: TXmlSkippedEntitySignal);
    procedure WriteStartDocumentSignal(const Signal: TXmlStartDocumentSignal);
    procedure WriteStartDocumentFragmentSignal(const Signal: TXmlStartDocumentFragmentSignal);
    procedure WriteStartElementSignal(const Signal: TXmlStartElementSignal);
    procedure WriteStartExtDtdSignal(const Signal: TXmlStartExtDtdSignal);
    procedure WriteStartIntDtdSignal(const Signal: TXmlStartIntDtdSignal);
  protected
    FOpenElementsCount: Integer;
    procedure DoAfterWrite(const PieceType: TDomPieceType;
                           const Locator: IDomLocator);
    procedure DoBeforeWrite(const PieceType: TDomPieceType;
                            const Locator: IDomLocator);
    procedure Reset; virtual;
    procedure SetIncludeXmlDecl(const Value: Boolean); virtual;
    procedure SetUseByteOrderMark(const Value: TXmlBOMOpt); virtual;
    procedure WriteByteOrderMark(const Sender: TXmlCustomReader;
                                 const Locator: IDomLocator;
                                   out ByteCount: Integer); virtual;
    procedure WriteWideStrings(const Sender: TXmlCustomReader;
                               const Locator: IDomLocator;
                               const XmlStrgs: array of WideString;
                               const UseCharRefs: Boolean); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ProcessSignal(const Signal: TXmlSignal); override;

    property ByteCount: Integer read FByteCount;
    property CharacterCount: Integer read FCharacterCount;
    property ColumnCount: Integer read FColumnCount;
    property CurrentEncoding: WideString read FCurrentEncoding;
    property CurrentCodecClass: TUnicodeCodecClass read GetCurrentCodecClass;
    property DefaultEncoding: WideString read FDefaultEncoding write SetDefaultEncoding;
    property DefaultCodecClass: TUnicodeCodecClass read FDefaultCodecClass;
    property LineFeedCount: Integer read FLineFeedCount;    
    property OutputSource: TXmlOutputSource read FOutputSource write SetOutputSource;
    property TabCount: Integer read FTabCount;
  published
    property UseByteOrderMark: TXmlBOMOpt read FUseByteOrderMark write SetUseByteOrderMark default [bomUTF16, bomUCS2]; 
    property IncludeXmlDecl: Boolean read FIncludeXmlDecl write SetIncludeXmlDecl default True;

    property OnAfterWrite: TDomSerializationEvent read FOnAfterWrite write FOnAfterWrite;
    property OnBeforeWrite: TDomSerializationEvent read FOnBeforeWrite write FOnBeforeWrite; 
  end;

  TXmlCustomParser = class(TDomBaseComponent)
  private
    FDOMImpl: TDomImplementation;
  protected
    procedure SetDomImpl(const Impl: TDomImplementation); virtual;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    property DOMImpl: TDomImplementation read FDOMImpl write SetDomImpl;
  end;

  TXmlToDomParser = class(TXmlCustomParser)
  private
    function GetKeepCDATASections: Boolean;
    function GetKeepComments: Boolean;
    function GetKeepEntityRefs: Boolean;
    procedure SetKeepCDATASections(const Value: Boolean);
    procedure SetKeepComments(const Value: Boolean);
    procedure SetKeepEntityRefs(const Value: Boolean);
  protected
    FBufferSize: Integer;
    FDocBuilder: TXmlDomBuilder;
    FDocReader:  TXmlStandardDocReader;
    FWFTestHandler: TXmlWFTestHandler;
    procedure CreateSubcomponents; virtual;
    procedure ParseFragment(const InputSource:TXmlSimpleInputSource;
                            const DocFrag: TDomDocumentFragment); virtual;
    function SendErrorNotification(const XmlErrorType: TXmlErrorType): Boolean; virtual;
    procedure SetBufferSize(const Value: Integer); virtual;
    procedure SetDomImpl(const Impl: TDomImplementation); override;
  public
    constructor Create(AOwner: TComponent); override;
    function FileToDom(const Filename: TFileName): TDomDocument; virtual;
    function SourceCodeToDom(const DocSourceCode: TXmlSourceCode;
                             const SysId: WideString): TDomDocument; virtual;
    function StreamToDom(const Stream: TStream;
                         const SysId: WideString;
                         const CodecClass: TUnicodeCodecClass;
                         const InclDecl: Boolean): TDomDocument; virtual;
    function StringToDom(const S: string;
                         const SysId: WideString;
                         const CodecClass: TUnicodeCodecClass;
                         const InclDecl: Boolean): TDomDocument; virtual;
    function UriToDom(      Uri: WideString;
                      const CodecClass: TUnicodeCodecClass;
                      const InclDecl: Boolean): TDomDocument; virtual;
    function WideStringToDom(const S: WideString;
                             const SysId: WideString;
                             const CodecClass: TUnicodeCodecClass;
                             const InclDecl: Boolean): TDomDocument; virtual;
    function XmlInputSourceToDom(const InputSource: TXmlInputSource): TDomDocument; virtual;
  published
    property BufferSize: Integer read FBufferSize write SetBufferSize default 4096;
    property KeepCDATASections: Boolean read GetKeepCDATASections write SetKeepCDATASections default True;
    property KeepComments: Boolean read GetKeepComments write SetKeepComments default True;
    property KeepEntityRefs: Boolean read GetKeepEntityRefs write SetKeepEntityRefs default True;
  end;

  TDtdToDtdModelParser = class(TXmlCustomParser)
  private
    FBufferSize: Integer;
    FTargetDtdModel: TDtdModel;
  protected
    FDtdModelBuilder: TXmlDtdModelBuilder;
    FDtdReader: TXmlStandardDtdReader;
    FWFTestHandler: TXmlWFTestHandler;
    procedure CreateSubcomponents; virtual;
    function SendErrorNotification(const XmlErrorType: TXmlErrorType): Boolean; virtual;
    procedure SetBufferSize(const Value: Integer); virtual;
    procedure SetDomImpl(const ADOMImpl: TDomImplementation); override;
    procedure SetTargetDtdModel(const Value: TDtdModel); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ExtSubsetSourceCodeToDtdModel(const ExtDtdSourceCode: TXmlSourceCode;
                                            const PubId,
                                                  SysId: WideString); virtual;
    procedure ExtSubsetStreamToDtdModel(const Stream: TStream;
                                        const PubId,
                                              SysId: WideString;
                                        const CodecClass: TUnicodeCodecClass;
                                        const InclDecl: Boolean); virtual;
    procedure ExtSubsetStringToDtdModel(const S: string;
                                        const PubId,
                                              SysId: WideString;
                                        const CodecClass: TUnicodeCodecClass;
                                        const InclDecl: Boolean); virtual;
    procedure ExtSubsetWideStringToDtdModel(      S: WideString;
                                            const PubId,
                                                  SysId: WideString;
                                            const CodecClass: TUnicodeCodecClass;
                                            const InclDecl: Boolean); virtual;
    procedure IntSubsetSourceCodeToDtdModel(const IntDtdSourceCode: TXmlSourceCode;
                                            const PubId,
                                                  SysId: WideString;
                                            const Standalone: TDomStandalone;
                                            const IntSubsetStartByteNumber,
                                                  IntSubsetStartCharNumber,
                                                  IntSubsetStartColumn,
                                                  IntSubsetStartLine: Int64;
                                            const ResolveExtPEs: Boolean); virtual;
    procedure IntSubsetStreamToDtdModel(const Stream: TStream;
                                        const PubId,
                                              SysId: WideString;
                                        const CodecClass: TUnicodeCodecClass;
                                        const Standalone: TDomStandalone;
                                        const IntSubsetStartByteNumber,
                                              IntSubsetStartCharNumber,
                                              IntSubsetStartColumn,
                                              IntSubsetStartLine: Int64;
                                        const ResolveExtPEs: Boolean); virtual;
    procedure IntSubsetStringToDtdModel(const S: string;
                                        const PubId,
                                              SysId: WideString;
                                        const CodecClass: TUnicodeCodecClass;
                                        const Standalone: TDomStandalone;
                                        const IntSubsetStartByteNumber,
                                              IntSubsetStartCharNumber,
                                              IntSubsetStartColumn,
                                              IntSubsetStartLine: Int64;
                                        const ResolveExtPEs: Boolean); virtual;
    procedure IntSubsetWideStringToDtdModel(      S: WideString;
                                            const PubId,
                                                  SysId: WideString;
                                            const CodecClass: TUnicodeCodecClass;
                                            const Standalone: TDomStandalone;
                                            const IntSubsetStartByteNumber,
                                                  IntSubsetStartCharNumber,
                                                  IntSubsetStartColumn,
                                                  IntSubsetStartLine: Int64;
                                            const ResolveExtPEs: Boolean); virtual;
    procedure ParseDocTypeDecl(const DocTypeDecl: TDomDocumentTypeDecl;
                               const ResolveExtEntities: Boolean); virtual;
    procedure Prepare; virtual;

    property TargetDtdModel: TDtdModel read FTargetDtdModel write SetTargetDtdModel;
  published
    property BufferSize: Integer read FBufferSize write SetBufferSize default 4096;
  end;

  TDomToXmlParser = class(TXmlCustomParser)
  private
    FDomReader: TXmlStandardDomReader;
    FBufferSize: Integer;
    FStreamBuilder: TXmlStreamBuilder;
    FUseActiveCodePage: Boolean;
    FWFTestHandler: TXmlWFTestHandler;
    FWriteLFOption: TCodecWriteLFOption;
    function GetOnAfterWrite: TDomSerializationEvent;
    function GetOnBeforeWrite: TDomSerializationEvent;
    function GetStrictErrorChecking: Boolean;
    function GetUseByteOrderMark: TXmlBOMOpt;
    procedure SetOnAfterWrite(const Value: TDomSerializationEvent);
    procedure SetOnBeforeWrite(const Value: TDomSerializationEvent);
    procedure SetStrictErrorChecking(const Value: Boolean);
    procedure SetUseByteOrderMark(const Value: TXmlBOMOpt);
  protected
    function GetIgnoreUnspecified: Boolean; virtual;
    function GetIncludeXmlDecl: Boolean; virtual;
    procedure SetBufferSize(const Value: Integer); virtual;
    procedure SetIgnoreUnspecified(const Value: Boolean); virtual;
    procedure SetIncludeXmlDecl(const Value: Boolean); virtual;
    {$IFNDEF LINUX}
    procedure SetUseActiveCodePage(const Value: Boolean); virtual; {$IFDEF VER140+} platform; {$ENDIF}
    {$ENDIF}
    procedure SetWriteLFOption(const Value: TCodecWriteLFOption); virtual;

    property DomReader: TXmlStandardDomReader read FDomReader;
    property StreamBuilder: TXmlStreamBuilder read FStreamBuilder;
    property WFTestHandler: TXmlWFTestHandler read FWFTestHandler;
  public
    constructor Create(AOwner: TComponent); override;
    function WriteToStream(const WNode: TDomNode;
                           const Encoding: WideString;
                           const Destination: TStream): Boolean; virtual;
    function WriteToString(const WNode: TDomNode;
                                 Encoding: WideString;
                             out S: string): Boolean; virtual;
    function WriteToWideString(const WNode: TDomNode;
                                 out S: WideString): Boolean; virtual;
  published
    property BufferSize: Integer read FBufferSize write SetBufferSize default 4096;
    property IgnoreUnspecified: Boolean read GetIgnoreUnspecified write SetIgnoreUnspecified;
    property IncludeXmlDecl: Boolean read GetIncludeXmlDecl write SetIncludeXmlDecl default True;
    property StrictErrorChecking: Boolean read GetStrictErrorChecking write SetStrictErrorChecking default False;
    {$IFNDEF LINUX}
    property UseActiveCodePage: Boolean read FUseActiveCodePage write SetUseActiveCodePage default False;
    {$ENDIF}
    property UseByteOrderMark: TXmlBOMOpt read GetUseByteOrderMark write SetUseByteOrderMark default [bomUTF16, bomUCS2];
    property WriteLFOption: TCodecWriteLFOption read FWriteLFOption write SetWriteLFOption default lwCRLF;

    property OnAfterWrite: TDomSerializationEvent read GetOnAfterWrite write SetOnAfterWrite;
    property OnBeforeWrite: TDomSerializationEvent read GetOnBeforeWrite write SetOnBeforeWrite;
  end;


{XPath implementation}

  TDomXPathExpr  = class;

  TDomXPathTokenType = ( XPATH_LEFT_PARENTHESIS_TOKEN,
                         XPATH_RIGHT_PARENTHESIS_TOKEN,
                         XPATH_LEFT_SQUARE_BRACKET_TOKEN,
                         XPATH_RIGHT_SQUARE_BRACKET_TOKEN,
                         XPATH_SINGLE_DOT_TOKEN,
                         XPATH_DOUBLE_DOT_TOKEN,
                         XPATH_COMMERCIAL_AT_TOKEN,
                         XPATH_COMMA_TOKEN,
                         XPATH_DOUBLE_COLON_TOKEN,
                         XPATH_NAME_TEST_TOKEN,
                         XPATH_NODE_TYPE_COMMENT_TOKEN,
                         XPATH_NODE_TYPE_TEXT_TOKEN,
                         XPATH_NODE_TYPE_PI_TOKEN,
                         XPATH_NODE_TYPE_NODE_TOKEN,
                         XPATH_AND_OPERATOR_TOKEN,
                         XPATH_OR_OPERATOR_TOKEN,
                         XPATH_MOD_OPERATOR_TOKEN,
                         XPATH_DIV_OPERATOR_TOKEN,
                         XPATH_MULTIPLY_OPERATOR_TOKEN,
                         XPATH_SLASH_OPERATOR_TOKEN,
                         XPATH_SHEFFER_STROKE_OPERATOR_TOKEN,
                         XPATH_PLUS_OPERATOR_TOKEN,
                         XPATH_MINUS_OPERATOR_TOKEN,
                         XPATH_IS_EQUAL_OPERATOR_TOKEN,
                         XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN,
                         XPATH_LESS_THAN_OPERATOR_TOKEN,
                         XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN,
                         XPATH_GREATER_THAN_OPERATOR_TOKEN,
                         XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN,
                         XPATH_FUNCTION_NAME_TOKEN,
                         XPATH_AXIS_NAME_ANCESTOR_TOKEN,
                         XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN,
                         XPATH_AXIS_NAME_ATTRIBUTE_TOKEN,
                         XPATH_AXIS_NAME_CHILD_TOKEN,
                         XPATH_AXIS_NAME_DESCENDANT_TOKEN,
                         XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN,
                         XPATH_AXIS_NAME_FOLLOWING_TOKEN,
                         XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN,
                         XPATH_AXIS_NAME_NAMESPACE_TOKEN,
                         XPATH_AXIS_NAME_PARENT_TOKEN,
                         XPATH_AXIS_NAME_PRECEDING_TOKEN,
                         XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN,
                         XPATH_AXIS_NAME_SELF_TOKEN,
                         XPATH_LITERAL_TOKEN,
                         XPATH_NUMBER_TOKEN,
                         XPATH_VARIABLE_REFERENCE_TOKEN,
                         XPATH_END_OF_TEXT_TOKEN,
                         XPATH_INVALID_TOKEN
                       );

  TDomXPathAxisType = ( XPATH_FORWARD_AXIS, XPATH_REVERSE_AXIS );

  TDomXPathFunction = function(const ContextNode: TDomNode;
                               const ContextPosition: Integer;
                               const ContextSize: Integer;
                               const Arguments: TList): TDomXPathCustomResult;

  TDomXPathSlashStatus = ( SL_NO_DOUBLE_SLASH,
                           SL_XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN_FOLLOWS,
                           SL_XPATH_DOUBLE_COLON_TOKEN_FOLLOWS,
                           SL_XPATH_NODE_TYPE_NODE_TOKEN_FOLLOWS,
                           SL_XPATH_LEFT_PARENTHESIS_FOLLOWS,
                           SL_XPATH_RIGHT_PARENTHESIS_FOLLOWS,
                           SL_XPATH_SLASH_OPERATOR_TOKEN_FOLLLOWS );

  TDomXPathTokenizer = class
  protected
    FCacheIsActive: Boolean;
    FDoubleSlashStatus: TDomXPathSlashStatus;
    FExpression: WideString;
    FLastSymbol: TDomXPathTokenType;
    FPosition: Integer;
    FPositionCache: Integer;
    FSymbolCache: TDomXPathTokenType;
    FValueCache: WideString;
    function DoubleColonFollows: Boolean; virtual;
    function GetNextWideChar(out S: WideChar): Boolean; virtual;
    function LeftParanthesisFollows: Boolean; virtual;
    function LookAheadNextWideChar(out S: WideChar): Boolean; virtual;
  public
    constructor Create(const Expression: WideString;
                       const XPathVersion: WideString); virtual;
    function IsFollowing(const Symbol: TDomXPathTokenType): Boolean; virtual;
    procedure Read(out Symbol: TDomXPathTokenType;
                   out Value: WideString;
                   out Position: Integer); virtual;
    procedure Reset; virtual;
  end;

  TDomXPathCustomResult = class(TCustomOwnedNode)
  protected
    function GetAxisType: TDomXPathAxisType; virtual;
    procedure SetAxisType(const Value: TDomXPathAxisType); virtual;
  public
    constructor Create;
    function AsBoolean: Boolean; virtual; abstract;
    function AsNumber: Double; virtual; abstract;
    function AsWideString: WideString; virtual; abstract;
    function Item(const Index: Integer): TDomNode; virtual;
    function Length: Integer; virtual;
    function ResultType: TDomXPathResultType; virtual; abstract;

    property AxisType: TDomXPathAxisType read GetAxisType write SetAxisType;
  end;

  TDomXPathResultClass = class of TDomXPathCustomResult;

  TDomXPathNodeSetResult = class(TDomXPathCustomResult)
  private
    function CreateXPathNamespace(const AOwnerElement: TDomElement;
                                  const ANamespaceUri,
                                        APrefix: WideString): TDomXPathNamespace;
  protected
    FAxisType: TDomXPathAxisType;
    FList: TList;
    procedure AddXPathNamespace(const AOwnerElement: TDomElement;
                                const ANamespaceUri,
                                      APrefix: WideString); virtual;
    function GetAxisType: TDomXPathAxisType; override;
    procedure Insert(const Index: Integer;
                     const Node: TDomNode); virtual;
    procedure SetAxisType(const Value: TDomXPathAxisType); override;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Add(const Node: TDomNode); virtual;
    procedure AddSubtree(const Node: TDomNode); virtual;
    function AsBoolean: Boolean; override;
    function AsNumber: Double; override;
    procedure Assign(Source: TPersistent); override;
    function AsWideString: WideString; override;
    procedure Clear; reintroduce; virtual;
    procedure Delete(const Index: Integer); virtual;
    function Item(const Index: Integer): TDomNode; override;
    function Length: Integer; override;
    procedure Merge(const NodeSet: TDomXPathNodeSetResult); virtual;
    function ResultType: TDomXPathResultType; override;
    procedure Sort; virtual;
  end;

  TDomXPathBooleanResult = class(TDomXPathCustomResult)
  private
    FBooleanValue: Boolean;
  public
    constructor Create(const ABooleanValue: Boolean); virtual;
    function AsBoolean: Boolean; override;
    function AsNumber: Double; override;
    function AsWideString: WideString; override;
    function ResultType: TDomXPathResultType; override;
  end;

  TDomXPathNumberResult = class(TDomXPathCustomResult)
  private
    FNumberValue: Double;
  public
    constructor Create(const ANumberValue: Double); virtual;
    function AsBoolean: Boolean; override;
    function AsNumber: Double; override;
    function AsWideString: WideString; override;
    function ResultType: TDomXPathResultType; override;
  end;

  TDomXPathStringResult = class(TDomXPathCustomResult)
  private
    FStringValue: WideString;
  public
    constructor Create(const AStringValue: WideString); virtual;
    function AsBoolean: Boolean; override;
    function AsNumber: Double; override;
    function AsWideString: WideString; override;
    function ResultType: TDomXPathResultType; override;
  end;

  TDomXPathSyntaxTree = class(TCustomOwnedObject)
  private
    FOwnerXPathExpression: TXPathExpression;
  protected
    FRootExpr: TDomXPathExpr;
    function CreateSyntaxNode(const Symbol: TDomXPathTokenType;
                              const Value: WideString): TDomXPathSyntaxNode; virtual;
    function GetContextNode: TDomNode; virtual;
    function GetIsPrepared: Boolean; virtual;
    function LookupNamespaceURI(const APrefix: WideString): WideString;
  public
    constructor Create(AOwner: TXPathExpression);
    procedure Clear; override;
    function Evaluate: TDomXPathCustomResult; virtual;
    function Prepare(const Expression: WideString): Boolean; virtual;
    property ContextNode: TDomNode read GetContextNode;
    property IsPrepared: Boolean read GetIsPrepared;
    property OwnerXPathExpression: TXPathExpression read FOwnerXPathExpression;
  end;

  TXPathExpression = class(TDomBaseComponent)
  private
    FOnLookupNamespaceURI: TDomXPathLookupNamespaceURIEvent;
  protected
    FContextNode: TDomNode;              // The context node for this XPath expression.
    FIsValid: TDomTrinarean;             // Indicates whether the XPath expression is valid.
    FExpression: WideString;             // Holds the expression to be evaluated.
    FSyntaxTree: TDomXPathSyntaxTree;    // Holds the XPath syntax tree.
    FXPathResult: TDomXPathCustomResult; // Holds the result of the evaluation.
    function LookupNamespaceURI(const APrefix: WideString): WideString;
    procedure SetContextNode(const Node: TDomNode); virtual;
    procedure SetExpression(const S: WideString); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AcquireXPathResult(const ResultType: TDomXPathResultClass): TDomXPathCustomResult; virtual;
    function Evaluate: Boolean; virtual;
    function HasNodeSetResult: Boolean; virtual;
    function Prepare: Boolean; virtual;
    function ResultAxisType: TDomXPathAxisType; virtual;
    function ResultAsBoolean: Boolean; virtual;
    function ResultAsNumber: Double; virtual;
    function ResultAsWideString: WideString; virtual;
    function ResultNode(const Index: Integer): TDomNode; virtual;
    function ResultLength: Integer; virtual;

    property ContextNode: TDomNode read FContextNode write SetContextNode;
    property IsValid: TDomTrinarean read FIsValid;
  published
    property Expression: WideString read FExpression write SetExpression;

    property OnLookupNamespaceURI: TDomXPathLookupNamespaceURIEvent read FOnLookupNamespaceURI write FOnLookupNamespaceURI;
  end;

  TDomXPathSyntaxNodeStack = class
  private
    FNodeList: TList;
  protected
    function GetLength: Integer; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear; virtual;
    function Peek(Offset: Integer): TDomXPathSyntaxNode; virtual;
    function Pop: TDomXPathSyntaxNode; virtual;
    function Push(Node: TDomXPathSyntaxNode): TDomXPathSyntaxNode; virtual;
    property Length: Integer read GetLength;
  end;

  TDomXPathSyntaxNode = class(TCustomOwnedObject)
  protected
    FLeft: TDomXPathSyntaxNode;
    FRight: TDomXPathSyntaxNode;
    FValue: WideString;
    function GetOwnerSyntaxTree: TDomXPathSyntaxTree; virtual;
    function LookupNamespaceURI(const APrefix: WideString): WideString;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); virtual;
    property Left: TDomXPathSyntaxNode read FLeft write FLeft;
    property OwnerSyntaxTree: TDomXPathSyntaxTree read GetOwnerSyntaxTree;
    property Right: TDomXPathSyntaxNode read FRight write FRight;
    property Value: WideString read FValue;
  end;

  // Cf. XPath 1.0, prod. [2].
  TDomXPathAbsoluteLocationPath = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [4].
  TDomXPathStep = class(TDomXPathSyntaxNode)
  public
    function AddStep(const Step: TDomXPathStep): Boolean; virtual;
    function Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [6].
  // This class is only used as a common ancestor of the axis name classes below.
  TDomXPathCustomAxisName = class(TDomXPathSyntaxNode)
  protected
    FAxisType: TDomXPathAxisType;
    FPrincipalNodeType: TDomNodeType;
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; virtual; abstract;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
    function Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult; virtual;
    property AxisType: TDomXPathAxisType read FAxisType;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameAncestor = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameAncestorOrSelf = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameAttribute = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameChild = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameDescendant = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameDescendantOrSelf = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameFollowing = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameFollowingSibling = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameNamespace = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameParent = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNamePreceding = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNamePrecedingSibling = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
  end;

  // Cf. XPath 1.0, prod. [6].
  TDomXPathAxisNameSelf = class(TDomXPathCustomAxisName)
  protected
    function GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult; override;
  end;

  // Cf. XPath 1.0, prod. [7].
  TDomXPathNodeTest = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const oldsnapshotResult: TDomXPathNodeSetResult;
                      const PrincipalNodeType: TDomNodeType): TDomXPathNodeSetResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [8].
  TDomXPathPredicate = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [14].
  TDomXPathExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition: Integer;
                      const ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [15].
  TDomXPathPrimaryExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition: Integer;
                      const ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [16].
  TDomXPathFunctionCall = class(TDomXPathSyntaxNode)
  private
    FArguments: TList;
  protected
    FPrefix: WideString;
    FLocalName: WideString;
    FXPathFunction: TDomXPathFunction;
    function GetFunctionName: WideString; virtual;
    procedure SetFunctionName(const AFunctionName: WideString); virtual;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
    destructor Destroy; override;
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition: Integer;
                      const ContextSize: Integer): TDomXPathCustomResult; virtual;
    property Arguments: TList read FArguments;
    property FunctionName: WideString read GetFunctionName write SetFunctionName;
  end;

  // Cf. XPath 1.0, prod. [18].
  TDomXPathUnionExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition: Integer;
                      const ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [19].
  TDomXPathPathExpr = class(TDomXPathSyntaxNode)
  public
    function AddStep(const Step: TDomXPathStep): Boolean; virtual;
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition: Integer;
                      const ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [20].
  TDomXPathFilterExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition: Integer;
                      const ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [21].
  TDomXPathOrExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [22].
  TDomXPathAndExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [23].
  TDomXPathEqualityExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; virtual; abstract;
  end;

  TDomXPathIsEqualExpr = class(TDomXPathEqualityExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  TDomXPathIsNotEqualExpr = class(TDomXPathEqualityExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  // Cf. XPath 1.0, prod. [24].
  TDomXPathRelationalExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; virtual; abstract;
  end;

  TDomXPathLessThanExpr = class(TDomXPathRelationalExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  TDomXPathLessThanOrEqualExpr = class(TDomXPathRelationalExpr)
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  TDomXPathGreaterThanExpr = class(TDomXPathRelationalExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  TDomXPathGreaterThanOrEqualExpr = class(TDomXPathRelationalExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  // Cf. XPath 1.0, prod. [25].
  TDomXPathAdditiveExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; virtual; abstract;
  end;

  TDomXPathPlusExpr = class(TDomXPathAdditiveExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  TDomXPathMinusExpr = class(TDomXPathAdditiveExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  // Cf. XPath 1.0, prod. [26].
  TDomXPathMultiplicativeExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; virtual; abstract;
  end;

  TDomXPathMultiplyExpr = class(TDomXPathMultiplicativeExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  TDomXPathDivExpr = class(TDomXPathMultiplicativeExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  TDomXPathModExpr = class(TDomXPathMultiplicativeExpr)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; override;
  end;

  // Cf. XPath 1.0, prod. [27].
  TDomXPathUnaryExpr = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const ContextNode: TDomNode;
                      const ContextPosition,
                            ContextSize: Integer): TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathLeftParenthesis = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathRightParenthesis = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathLeftSquareBracket = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathRightSquareBracket = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathSingleDot = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathDoubleDot = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathCommercialAt = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathComma = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [28].
  TDomXPathDoubleColon = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [29].
  TDomXPathLiteral = class(TDomXPathSyntaxNode)
  public
    function Evaluate: TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [30].
  TDomXPathNumber = class(TDomXPathSyntaxNode)
  public
    function Evaluate: TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathSlashOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathShefferStrokeOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathPlusOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathMinusOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathIsEqualOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathIsNotEqualOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathLessThanOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathLessThanOrEqualOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathGreaterThanOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [32].
  TDomXPathGreaterThanOrEqualOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [33].
  TDomXPathAndOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [33].
  TDomXPathOrOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [33].
  TDomXPathModOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [33].
  TDomXPathDivOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [34].
  TDomXPathMultiplyOperator = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [35].
  TDomXPathFunctionName = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [36].
  TDomXPathVariableReference = class(TDomXPathSyntaxNode)
  protected
    FPrefix: WideString;
    FLocalName: WideString;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
    function Evaluate: TDomXPathCustomResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [37].
  TDomXPathNameTest = class(TDomXPathSyntaxNode)
  protected
    FPrefix: WideString;
    FLocalName: WideString;
  public
    constructor Create(const AOwner: TDomXPathSyntaxTree;
                       const Value: WideString); override;
    function Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult;
                      const PrincipalNodeType: TDomNodeType): TDomXPathNodeSetResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [38].
  TDomXPathNodeTypeComment = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [38].
  TDomXPathNodeTypeNode = class(TDomXPathSyntaxNode)
  end;

  // Cf. XPath 1.0, prod. [38].
  TDomXPathNodeTypePI = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult; virtual;
  end;

  // Cf. XPath 1.0, prod. [38].
  TDomXPathNodeTypeText = class(TDomXPathSyntaxNode)
  public
    function Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult; virtual;
  end;

{ XPath Helper Functions}
function XPathRound(const D: Double): Double;
function XPathWideStringToNumber(const S: WideString): Double;

{ XPath Conversion Functions }
function XPathBooleanFunc(const oldResult: TDomXPathCustomResult): TDomXPathBooleanResult;
function XPathNumberFunc(const oldResult: TDomXPathCustomResult): TDomXPathNumberResult;
function XPathStringFunc(const oldResult: TDomXPathCustomResult): TDomXPathStringResult;

{ XPath Function Library -- see XPath 1.0, sec. 4 }

{ XPath Node set Functions -- see XPath 1.0, sec. 4.1. }

function XPathFunctionLast(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionPosition(const ContextNode: TDomNode;
                               const ContextPosition: Integer;
                               const ContextSize: Integer;
                               const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionCount(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionId(const ContextNode: TDomNode;
                         const ContextPosition: Integer;
                         const ContextSize: Integer;
                         const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionLocalName(const ContextNode: TDomNode;
                                const ContextPosition: Integer;
                                const ContextSize: Integer;
                                const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionNamespaceUri(const ContextNode: TDomNode;
                                   const ContextPosition: Integer;
                                   const ContextSize: Integer;
                                   const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionName(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;

{ XPath String Functions -- see XPath 1.0, sec. 4.2. }

function XPathFunctionString(const ContextNode: TDomNode;
                             const ContextPosition: Integer;
                             const ContextSize: Integer;
                             const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionConcat(const ContextNode: TDomNode;
                             const ContextPosition: Integer;
                             const ContextSize: Integer;
                             const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionStartsWith(const ContextNode: TDomNode;
                                 const ContextPosition: Integer;
                                 const ContextSize: Integer;
                                 const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionContains(const ContextNode: TDomNode;
                               const ContextPosition: Integer;
                               const ContextSize: Integer;
                               const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionSubstringBefore(const ContextNode: TDomNode;
                                      const ContextPosition: Integer;
                                      const ContextSize: Integer;
                                      const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionSubstringAfter(const ContextNode: TDomNode;
                                     const ContextPosition: Integer;
                                     const ContextSize: Integer;
                                     const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionSubstring(const ContextNode: TDomNode;
                                const ContextPosition: Integer;
                                const ContextSize: Integer;
                                const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionStringLength(const ContextNode: TDomNode;
                                   const ContextPosition: Integer;
                                   const ContextSize: Integer;
                                   const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionNormalizeSpace(const ContextNode: TDomNode;
                                     const ContextPosition: Integer;
                                     const ContextSize: Integer;
                                     const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionTranslate(const ContextNode: TDomNode;
                                const ContextPosition: Integer;
                                const ContextSize: Integer;
                                const Arguments: TList): TDomXPathCustomResult;

{ XPath Boolean Functions -- see XPath 1.0, sec. 4.3. }

function XPathFunctionBoolean(const ContextNode: TDomNode;
                              const ContextPosition: Integer;
                              const ContextSize: Integer;
                              const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionNot(const ContextNode: TDomNode;
                          const ContextPosition: Integer;
                          const ContextSize: Integer;
                          const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionTrue(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionFalse(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionLang(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;

{ XPath Number Functions -- see XPath 1.0, sec. 4.4. }

function XPathFunctionNumber(const ContextNode: TDomNode;
                             const ContextPosition: Integer;
                             const ContextSize: Integer;
                             const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionSum(const ContextNode: TDomNode;
                          const ContextPosition: Integer;
                          const ContextSize: Integer;
                          const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionFloor(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionCeiling(const ContextNode: TDomNode;
                              const ContextPosition: Integer;
                              const ContextSize: Integer;
                              const Arguments: TList): TDomXPathCustomResult;

function XPathFunctionRound(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;


// Whitespace Processing
function NormalizeSpace(const S: WideString): WideString;
function NormalizeWhiteSpace(const S: WideString): WideString;
function TrimWhitespace(const S: WideString): WideString;
function TrimWhitespaceLeft(const S: WideString): WideString;
function TrimWhitespaceRight(const S: WideString): WideString;

// Routines for XML Namespace Processing
function XmlExtractPrefix(const QualifiedName: WideString): WideString;
function XmlExtractLocalName(const QualifiedName: WideString): WideString;
function XmlExtractPrefixAndLocalName(    QualifiedName: WideString;
                                      out Prefix,
                                          LocalName: WideString): Boolean;

// Entity Reference Conversion
function EscapeDelimiters(const S: WideString): WideString;

// Character Reference Conversion
function ResolveCharRefs(const S: WideString): WideString;
function XmlCharRefToInt(const S: WideString): Integer;
function XmlCharRefToStr(const S: WideString): WideString;
function XmlIntToCharRef(const Value: Longint): WideString;
function XmlIntToCharRefHex(const Value: Longint): WideString;

// Other helper functions:
function XmlReplaceQuotes(const Source: WideString): WideString;

procedure XmlTruncRoundBrackets(    Source: WideString;
                                var Content: WideString;
                                out Error: Boolean);

procedure CalcNormalizedAttrValue(const AttrLiteralValue: WideString;
                                  out NormalizedValue: WideString;
                                  out Error: TXmlErrorType;
                                  ProcessXmlSpaces: Boolean = TRUE;
                                  ReadLFOption: TCodecReadLFOption = lrNormalize);

implementation

{$WARNINGS OFF}
{$HINTS OFF}
{$NOTES OFF}

uses
  LangUtils, UnicodeUtils, UriUtils, XmlRulesUtils,
    // The above units are contained in the Open XML Utilities package 1.x
    // available at "http://www.philo.de/xml/".
  Math;

const
  // Unicode scalar values of some important characters:
  TAB = $9;  // Horizontal Tabulation
  LF  = $A;  // Line Feed
  CR  = $D;  // Carriage Return
  DQ  = $22; // Double Quote ('"')
  AMP = $26; // Ampersand ('&')
  LT  = $3C; // Less Than ('<')
  GT  = $3E; // Greater Than ('>')

  // Constants for IEEE 754 floating point operations in XPath functions:
  // These constants should not be used for comparison, only assignments.
  // For comparison use the IsNegZero and IsPosZero functions provided below.
  NegZero = 0.0 / -1.0;

function IsNegZero(const AValue: Double): Boolean;
begin
  Result := PInt64(@AValue)^ = $8000000000000000;
end;

function IsPosZero(const AValue: Double): Boolean;
begin
  Result := PInt64(@AValue)^ = $0000000000000000;
end;

{$IFNDEF VER140+}
// Redeclarations of constants and functions which are not available in
// Delphi 5 or below.
const
  NaN =  0.0 / 0.0;

function IsNan(const AValue: Double): Boolean;
begin
  Result := ((PInt64(@AValue)^ and $7FF0000000000000)  = $7FF0000000000000) and
            ((PInt64(@AValue)^ and $000FFFFFFFFFFFFF) <> $0000000000000000);
end;

function IsInfinite(const AValue: Double): Boolean;
begin
  Result := ((PInt64(@AValue)^ and $7FF0000000000000) = $7FF0000000000000) and
            ((PInt64(@AValue)^ and $000FFFFFFFFFFFFF) = $0000000000000000);
end;

type
  TValueSign = -1..1;

const
  NegativeValue = Low(TValueSign);
  ZeroValue = 0;
  PositiveValue = High(TValueSign);

function Sign(const AValue: Double): TValueSign;
begin
  if ((PInt64(@AValue)^ and $7FFFFFFFFFFFFFFF) = $0000000000000000) then
    Result := ZeroValue
  else if ((PInt64(@AValue)^ and $8000000000000000) = $8000000000000000) then
    Result := NegativeValue
  else
    Result := PositiveValue;
end;

{$ENDIF}

function XmlReplaceQuotes(const Source: WideString): WideString;
// This function replaces all single and double quotes
// with their respective character references.
var
  I: Integer;
  Content: TUtilsCustomWideStr;
begin
  Result := '';
  Content := TUtilsCustomWideStr.Create;
  try
    for I := 1 to Length(Source) do begin
      case Ord(Source[I]) of
        39: Content.AddWideString('&#39;'); // Single quote
        34: Content.AddWideString('&#34;'); // Double quote
      else
        Content.AddWideChar(Source[I]);
      end;
    end;
    Result := Content.Value;
  finally
    Content.Free;
  end;
end;

procedure XmlTruncRoundBrackets(    Source: WideString;
                                var Content: WideString;
                                out Error: Boolean);
// This procedure removes leading and trailing white space characters from
// Source.  Afterward it checks whether the remaining WideString is framed
// by round brackets -- '(' and ')'.  If this is the case, the brackets are
// being removed, and again any leading and trailing white space characters
// from the remaining WideString is being removed.  The resulting WideString
// is returned in the Content parameter and the Error parameter returns
// False.  If the check for the framing brackets fails, the Content parameter
// returns an empty WideString and the Error parameter returns True.
var
  BracketStr: WideString;
begin
  Content := '';
  BracketStr := TrimWhitespace(Source);
  if Length(BracketStr) < 2 then begin Error := True; Exit; end;
  if (BracketStr[1] <> '(') or (BracketStr[Length(BracketStr)] <> ')')
    then Error := True
    else begin
      Content := TrimWhitespace(Copy(BracketStr, 2, Length(BracketStr) - 2));
      Error := False;
    end;
end;

{ Whitespace Processing }

function NormalizeSpace(const S: WideString): WideString;
const
  NULL:  WideChar = #0;   // End of WideString mark
  SPACE: WideChar = #$20;
var
  I: Integer;
  LastPCharWasSpace: Boolean;
  P: PWideChar;
begin
  SetLength(Result, Length(S));
  I := 0;

  // Skip leading spaces:
  P := PWideChar(S);
  while P^ = SPACE do
    Inc(P);

  LastPCharWasSpace := False;
  while P^ <> NULL do begin
    if P^ = SPACE then begin
      LastPCharWasSpace := True;
    end else begin
      if LastPCharWasSpace then begin
        Inc(I);
        Result[I] := SPACE;
        LastPCharWasSpace := False;
      end;
      Inc(I);
      Result[I] := P^;
    end;
    Inc(P);
  end;

  SetLength(Result, I);
end;

function NormalizeWhiteSpace(const S: WideString): WideString;
const
  NULL:  WideChar = #0;   // End of WideString mark
  SPACE: WideChar = #$20;
var
  I: Integer;
  LastPCharWasWhitespace: Boolean;
  P: PWideChar;
begin
  SetLength(Result, Length(S));
  I := 0;

  // Skip leading white space:
  P := PWideChar(S);
  while IsXmlWhiteSpace(P^) do
    Inc(P);

  LastPCharWasWhitespace := False;
  while P^ <> NULL do begin
    if IsXmlWhiteSpace(P^) then begin
      LastPCharWasWhitespace := True;
    end else begin
      if LastPCharWasWhitespace then begin
        Inc(I);
        Result[I] := SPACE;
        LastPCharWasWhitespace := False;
      end;
      Inc(I);
      Result[I] := P^;
    end;
    Inc(P);
  end;

  SetLength(Result, I);
end;

function TrimWhitespace(const S: WideString): WideString;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and IsXmlWhiteSpace(S[I]) do Inc(I);
  if I > L then
    Result := ''
  else begin
    while IsXmlWhiteSpace(S[L]) do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;

function TrimWhitespaceLeft(const S: WideString): WideString;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and IsXmlWhiteSpace(S[I]) do Inc(I);
  Result := Copy(S, I, Maxint);
end;

function TrimWhitespaceRight(const S: WideString): WideString;
var
  I: Integer;
begin
  I := Length(S);
  while (I > 0) and IsXmlWhiteSpace(S[I]) do Dec(I);
  Result := Copy(S, 1, I);
end;

function XmlExtractPrefix(const QualifiedName: WideString): WideString;
var
  ColonPos: Integer;
  LocalPart: WideString;  // = 0
  Prefix: WideString;     // = 0
begin
  ColonPos := Pos(':', QualifiedName);
  if ColonPos = 0
    then LocalPart := QualifiedName
    else begin
      Prefix:= Copy(QualifiedName, 1, ColonPos - 1);
      LocalPart:= Copy(QualifiedName, ColonPos + 1, Length(QualifiedName) - ColonPos);
      if not IsXmlPrefix(Prefix)
        then raise EInvalid_Character_Err.Create('Invalid character error.');
    end;
  if not IsXmlLocalPart(LocalPart)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  Result := Prefix;
end;

function XmlExtractLocalName(const QualifiedName: WideString): WideString;
var
  ColonPos: Integer;
  Prefix,LocalPart: WideString;
begin
  ColonPos := Pos(':', QualifiedName);
  if ColonPos = 0
    then LocalPart := QualifiedName
    else begin
      Prefix:= Copy(QualifiedName, 1, ColonPos - 1);
      LocalPart:= Copy(QualifiedName, ColonPos + 1, Length(QualifiedName) - ColonPos);
      if not IsXmlPrefix(Prefix)
        then raise EInvalid_Character_Err.Create('Invalid character error.');
  end;
  if not IsXmlLocalPart(LocalPart)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  Result := LocalPart;
end;

function XmlExtractPrefixAndLocalName(    QualifiedName: WideString;
                                      out Prefix,
                                          LocalName: WideString): Boolean;
var
  ColonPos: Integer;
begin
  ColonPos := Pos(':', QualifiedName);
  if ColonPos = 0 then begin
      Prefix := '';
      if IsXmlLocalPart(QualifiedName) then begin
        LocalName:= QualifiedName;
        Result := True;
      end else begin
        LocalName:= '';
        Result := False;
      end;
    end else begin
      Prefix := Copy(QualifiedName, 1, ColonPos -1 );
      LocalName := Copy(QualifiedName, ColonPos + 1, Length(QualifiedName) - ColonPos);
      if IsXmlPrefix(Prefix) and IsXmlLocalPart(LocalName) then begin
        Result := True;
      end else begin
        Prefix := '';
        LocalName := '';
        Result := False;
      end;
  end;
end;

function EscapeDelimiters(const S: WideString): WideString;
var
  Content: TUtilsCustomWideStr;
  I: Integer;
begin
  Content:= TUtilsCustomWideStr.Create;
  try
    for I := 1 to Length(S) do
      case Ord(S[I]) of
        34: Content.AddWideString('&quot;');
        38: Content.AddWideString('&amp;');
        39: Content.AddWideString('&apos;');
        60: Content.AddWideString('&lt;');
        62: Content.AddWideString('&gt;');
      else
        Content.AddWideChar(S[I]);
      end;
    Result := Content.Value;
  finally
    Content.Free;
  end;
end;

function ResolveCharRefs(const S: WideString): WideString;
const
  BOM: WideChar = #$FEFF;  // Byte order mark
var
  I, J, IndexPos: Integer;
  SChar, SChar2: WideChar;
  Ref: WideString;
  Content: TUtilsCustomWideStr;
begin
  Result := '';
  Content:= TUtilsCustomWideStr.Create;
  try
    I := 1;

    // Check for byte order mark:
    if Length(S) > 0 then begin
      if S[1] = BOM then begin
        Content.AddWideChar(BOM);
        I := 2;
      end;
    end;

    while I <= Length(S) do begin
      SChar := WideChar((PWideChar(S)+I-1)^);
      if IsUtf16LowSurrogate(SChar) then
        raise EConvertError.Create('WideString must not start with a UTF-16 low surrogate.');
      if IsUtf16HighSurrogate(SChar) then begin
        if I = Length(S) then
          raise EConvertError.Create('WideString must not end with a UTF-16 high surrogate.');
        Inc(I);
        Content.AddWideChar(SChar);
        SChar := WideChar((PWideChar(S) + I - 1)^);
        if not IsUtf16LowSurrogate(SChar) then
          raise EConvertError.Create('WideString contains an UTF-16 high surrogate without its corresponding low surrogate.');
      end;
      if not IsXmlChar(SChar) then
        raise EConvertError.Create('WideString contains an invalid character.');
      if SChar = '&' then begin {Reference?}
        IndexPos := -1;
        for J := I + 1 to Length(S) do begin
          SChar2:= WideChar((PWideChar(S) + J - 1)^);
          if SChar2 = ';' then begin IndexPos := J; Break; end;
        end;
        if IndexPos = -1 then
          raise EConvertError.Create('WideString contains an ''&'' without a '';''.');
        Ref:= Copy(S, I, Indexpos - I + 1);
        if IsXmlEntityRef(Ref) then begin
          Content.AddWideString(Ref);
        end else if IsXmlCharRef(Ref) then begin
          Content.AddWideString(XmlCharRefToStr(Ref));
        end else
          raise EConvertError.CreateFmt('WideString contains an invalid reference %S.',[Ref]);
        I := IndexPos;
      end else
        Content.AddWideChar(SChar);
      Inc(I);
    end; {while ...}
    Result := Content.Value;
  finally
    Content.Free;
  end;
end;

function XmlCharRefToInt(const S: WideString): Integer;
var
  Value: word;
begin
  if not IsXmlCharRef(S)
    then raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]);
  if S[3] = 'x'
    then Result := StrToInt(Concat('$',Copy(S, 4, Length(S) - 4))) // Hex
    else Result := StrToInt(Copy(S, 3, Length(S) - 3));            // Dec
  if Result > $10FFFF
    then raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]);
  if Result < $10000 then begin
    Value := Result;
    if not IsXmlChar(WideChar(Value))
      then raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]);
    case Result of
      $D800..$DBFF, // Reserved for high surrogate of Unicode character [$10000..$10FFFF]
      $DC00..$DFFF: // Reserved for low surrogate of Unicode character [$10000..$10FFFF]
      raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]);
    end; {case ...}
  end; {if ...}
end;

function XmlCharRefToStr(const S: WideString): WideString;
var
  Value: Integer;
  SmallValue: Word;
begin
  Value := XmlCharRefToInt(S);
  if Value < $10000 then begin
    SmallValue := Value;
    Result := WideString(WideChar(SmallValue));
  end else
    Result := Concat(WideString(Utf16HighSurrogate(Value)),
                     WideString(Utf16LowSurrogate(Value)));
end;

function XmlIntToCharRef(const Value: Longint): WideString;
begin
  Result := Concat('&#', IntToStr(Value), ';');
end;

function XmlIntToCharRefHex(const Value: Longint): WideString;
begin
  Result := Concat('&#x', IntToHex(Value, 1), ';');
end;

function XPathRound(const D: Double): Double;
begin
  if IsNaN(D) or IsInfinite(D) or IsNegZero(D) or IsPosZero(D)
    then Result := D
    else Result := Floor(D + 0.5);
  if (Result = 0) and (D < 0) then
    Result := NegZero;
end;

function XPathWideStringToNumber(const S: WideString): Double;
var
  DecimalPointFound: Boolean;
  E: Integer;
  B, P: PWideChar;
  W: Word;
begin
  Result := NaN;
  DecimalPointFound := False;
  E := 0;
  B := PWideChar(S);
  P := B + Length(S) - 1;

  // Skip trailing white space:
  while (P >= B) and IsXmlWhiteSpace(P^) do
    Dec(P);

  if P >= B then begin
    if Ord(P^) = $2E then begin // '.' at the end of the number --> invalid
      Result := NaN;
      Exit;
    end else Result := 0;
  end;

  while P >= B do begin
    W := Ord(P^);
    if W <= $39 then begin
      if W >= $30 then begin // Digit
        Result := Result + ( (W - $30) * Power(10, E) );
        Inc(E);
      end else if W = $2E then begin // '.'
        if DecimalPointFound then begin
          Result := NaN;
          Exit;
        end;
        Result := Result / Power(10, E);
        E := 0;
        DecimalPointFound := True;
      end else if W = $2D then begin // '-'
        Result := -Result;
        Dec(P);
        Break;
      end else Break;
    end else Break;
    Dec(P);
  end;

  // Skip leading white space:
  while (P >= B) and IsXmlWhiteSpace(P^) do
    Dec(P);

  if P >= B then Result := NaN;
end;

function XPathBooleanFunc(const OldResult: TDomXPathCustomResult): TDomXPathBooleanResult;
begin
  if not Assigned(OldResult) then
    raise ENot_Supported_Err.Create('Not supported error.');
  if OldResult.ResultType = XPATH_BOOLEAN_TYPE then begin
    Result := (OldResult as TDomXPathBooleanResult);
  end else begin
    Result := TDomXPathBooleanResult.Create(OldResult.AsBoolean);
    OldResult.Free;
  end;
end;

function XPathNumberFunc(const OldResult: TDomXPathCustomResult): TDomXPathNumberResult;
begin
  if not Assigned(OldResult) then
    raise ENot_Supported_Err.Create('Not supported error.');
  if OldResult.ResultType = XPATH_NUMBER_TYPE then begin
    Result := (OldResult as TDomXPathNumberResult);
  end else begin
    Result := TDomXPathNumberResult.Create(OldResult.AsNumber);
    OldResult.Free;
  end;
end;

function XPathStringFunc(const OldResult: TDomXPathCustomResult): TDomXPathStringResult;
begin
  if not Assigned(OldResult) then
    raise ENot_Supported_Err.Create('Not supported error.');
  if OldResult.ResultType = XPATH_STRING_TYPE then begin
    Result := (OldResult as TDomXPathStringResult);
  end else begin
    Result := TDomXPathStringResult.Create(OldResult.AsWideString);
    OldResult.Free;
  end;
end;



//+++++++++++++++++++++++++ TUtilsNoRefCount +++++++++++++++++++++++++

function TUtilsNoRefCount._AddRef: Integer;
begin
  Result := -1
end;

function TUtilsNoRefCount._Release: Integer;
begin
  Result := -1
end;

function TUtilsNoRefCount.QueryInterface(constref IID: TGUID;
  out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NoInterface;
end;



//+++++++++++++++++++++++++ TDomBaseComponent +++++++++++++++++++++++++
function TDomBaseComponent.GetXDOMVersion: WideString;
begin
  Result := '3.2.4';
end;



//++++++++++++++++++++++++ TDomImplementation +++++++++++++++++++++++++
constructor TDomImplementation.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwnedDocumentsList := TList.Create;
  FDocuments := TDomNodeList.Create(FOwnedDocumentsList);
  FResourceResolver := nil;
  FErrorReportLevel := 0;
end;

destructor TDomImplementation.Destroy;
begin
  Clear;
  FOwnedDocumentsList.Free;
  FDocuments.Free;
  inherited;
end;

procedure TDomImplementation.Attach(ADocument: TDomCustomDocument);
begin
  FOwnedDocumentsList.Add(ADocument);
end;

procedure TDomImplementation.Clear;
begin
  DestroyOwnedDocuments;
end;

procedure TDomImplementation.DestroyOwnedDocuments;
var
  I: Integer;
  TempDoc: TDomCustomDocument;
begin
  I := Pred(FOwnedDocumentsList.Count);
  while I >= 0 do
  begin
    TempDoc := FOwnedDocumentsList[I];
    TempDoc.FDomImpl := nil;       // For a better performance of larger collections: ...
    FOwnedDocumentsList.Delete(I); // ... Avoid the call to FDomImpl.Detach(Self) in ...
    Dec(I);                        // ... the destructor of the owned document to be freed.
    TempDoc.Free;
    if I >= FOwnedDocumentsList.Count then
      I := Pred(FOwnedDocumentsList.Count);
  end;
end;

procedure TDomImplementation.Detach(ADocument: TDomCustomDocument);
begin
  FOwnedDocumentsList.Remove(ADocument);
end;

procedure TDomImplementation.DisableErrorEvents;
begin
  Inc(FErrorReportLevel);
end;

procedure TDomImplementation.EnableErrorEvents;
begin
  Dec(FErrorReportLevel);
end;

function TDomImplementation.GetDocuments: TDomNodeList;
begin
  Result := FDocuments;
end;

function TDomImplementation.GetErrorEventsDisabled: Boolean;
begin
  Result := FErrorReportLevel > 0;
end;

procedure TDomImplementation.DoAttrModified(const ModifiedNode: TDomNode;
                                            const AttrChange: TDomAttrChange;
                                            const RelatedAttr: TDomAttr);
begin
  if Assigned(FOnAttrModified) then
    FOnAttrModified(Self, ModifiedNode, AttrChange, RelatedAttr);
end;

procedure TDomImplementation.DoCharacterDataModified(ModifiedNode: TDomNode);
begin
  if Assigned(FOnCharacterDataModified) then
    FOnCharacterDataModified(Self, ModifiedNode);
end;

procedure TDomImplementation.DoError(    Sender: TObject;
                                         Error: TDomError;
                                     var Go: Boolean);
begin
  case Error.Severity of
    DOM_SEVERITY_WARNING, DOM_SEVERITY_ERROR:
      Go := True;
    DOM_SEVERITY_FATAL_ERROR:
      Go := False;
  end;
  if Assigned(FOnError) and (FErrorReportLevel = 0) then
    FOnError(Sender, Error, Go);
end;

procedure TDomImplementation.DoNodeClearing(Node: TDomNode);
begin
  if Assigned(FOnNodeClearing) then
    FOnNodeClearing(Self, Node);
end;

procedure TDomImplementation.DoNodeInserted(Node: TDomNode);
begin
  if Assigned(FOnNodeInserted) then
    FOnNodeInserted(Self, Node);
end;

procedure TDomImplementation.DoNodeRemoving(Node: TDomNode);
begin
  if Assigned(FOnNodeRemoving) then
    FOnNodeRemoving(Self, Node);
end;

procedure TDomImplementation.DoRequestXPathFunctionResult(const NamespaceURI,
                                                                LocalName: WideString;
                                                          const ContextNode: TDomNode;
                                                          const ContextPosition,
                                                                ContextSize: Integer;
                                                          const Arguments: TList;
                                                            var Value: TDomXPathCustomResult);
begin
  if Assigned(FOnRequestXPathFunctionResult) then
    FOnRequestXPathFunctionResult(NamespaceURI, LocalName, ContextNode, ContextPosition, ContextSize, Arguments, Value);
end;

procedure TDomImplementation.DoRequestXPathVariable(const XPathExpression: TXPathExpression;
                                                    const NamespaceURI,
                                                          LocalName: WideString;
                                                      var Value: TDomXPathCustomResult);
begin
  if Assigned(FOnRequestXPathVariable) then
    FOnRequestXPathVariable(XPathExpression, NamespaceURI, LocalName, Value);
end;

function TDomImplementation.HandleError(const Sender: TObject;
                                        const Error: TDomError): Boolean;
begin
  if not Assigned(Error) then
    raise ENot_Supported_Err.Create('Not supported error.');
  DoError(Sender, Error, Result);
end;

procedure TDomImplementation.Notification(AComponent: TComponent;
                                          Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FResourceResolver) then
    FResourceResolver := nil;
end;

function TDomImplementation.ResolveResourceAsStream(const ABaseURI: WideString;
                                                      var PublicId,
                                                          SystemId: WideString): TStream;
begin
  if not Assigned(ResourceResolver) then
    raise ENot_Found_Err.Create('No resource resolver assigned to DOM implementation.');
  Result := ResourceResolver.ResolveResource(ABaseUri, PublicId, SystemId);
end;

procedure TDomImplementation.ResolveResourceAsWideString(const ABaseURI: WideString;
                                                           var PublicId,
                                                               SystemId: WideString;
                                                           out S: WideString;
                                                           out Error: TXmlErrorType);
var
  Content: TUtilsCustomWideStr;
  InputSrc: TXmlInputSource;
  Stream: TStream;
begin
  Stream := ResolveResourceAsStream(ABaseUri, PublicId, SystemId);
  if not Assigned(Stream) then begin
    S := '';
    Error := ET_EXT_ENTITY_RESOURCE_NOT_FOUND;
    Exit;
  end;

  // Convert external entity value to UTF-16:
  try
    try
      InputSrc := TXmlInputSource.Create(Stream, PublicId, SystemId, 4096, nil,  
                    False, 0, 0, 0, 0, 1);
    except
      on ENot_Supported_Err do begin
        S := '';
        Error := ET_ENCODING_NOT_SUPPORTED;
        Exit;
      end;
      on EConvertError do begin
        S := '';
        Error := ET_BYTE_ORDER_MARK_ENCODING_MISMATCH;
        Exit;
      end;
    end;

    try
      with InputSrc do begin
        if HasMalformedDecl
           or not ( DeclType in [ DT_TEXT_DECLARATION,
                                  DT_XML_OR_TEXT_DECLARATION,
                                  DT_UNSPECIFIED] )
          then begin
            S := '';
            Error := ET_INVALID_TEXT_DECL;
          end else if XmlVersion <> '1.0' then begin
            S := '';
            Error := ET_XML_VERSION_NOT_SUPPORTED;
          end else begin
            Error := ET_NONE;
            Content := TUtilsCustomWideStr.Create;
            try
              Next;
              while not Eof do
              begin
                Content.AddUCS4Char(CurrentCharInfo.CodePoint);
                Next;
              end;
              S := Content.Value;
            except
              S := '';
              Error := ET_INVALID_CHARACTER_IN_EXT_ENTITY;
            end;
            Content.Free;
          end;
      end; {with ...}
    finally
      InputSrc.Free;
    end; {try ...}
  finally
    Stream.Free;
  end; {try ...}
end;

procedure TDomImplementation.SetResourceResolver(const AResourceResolver: TCustomResourceResolver);
begin
  if FResourceResolver = AResourceResolver then Exit;
  {$IFDEF VER140+}
  if Assigned(FResourceResolver) then
    FResourceResolver.RemoveFreeNotification(Self);
  {$ENDIF}
  {$IFDEF LINUX}
  if Assigned(FResourceResolver) then
    FResourceResolver.RemoveFreeNotification(Self);
  {$ENDIF}
  FResourceResolver := AResourceResolver;
  if Assigned(AResourceResolver) then
    AResourceResolver.FreeNotification(Self);
end;



//++++++++++++++++++++++++++++ TDomTreeWalker +++++++++++++++++++++++++++++++
constructor TDomTreeWalker.Create(const Root: TDomNode;
                                  const WhatToShow: TDomWhatToShow;
                                  const NodeFilter: TDomNodeFilter;
                                  const EntityReferenceExpansion: Boolean);
begin
  if not Assigned(Root) then
    raise ENot_Supported_Err.Create('Not supported error.');
  inherited Create;
  FWhatToShow := WhatToShow;
  FFilter := NodeFilter;
  FExpandEntityReferences := EntityReferenceExpansion;
  FRoot := Root;
  FCurrentNode := Root;
end;

procedure TDomTreeWalker.SetCurrentNode(const Node: TDomNode);
begin
  if not Assigned(Node) then
    raise ENot_Supported_Err.Create('Not supported error.');
  FCurrentNode := Node;
end;

procedure TDomTreeWalker.SetExpandEntityReferences(const Value: Boolean);
begin
  FExpandEntityReferences := Value;
end;

procedure TDomTreeWalker.SetFilter(const Value: TDomNodeFilter);
begin
  FFilter := Value;
end;

procedure TDomTreeWalker.SetRoot(const Node: TDomNode);
begin
  if not Assigned(Node) then
    raise ENot_Supported_Err.Create('Not supported error.');
  FRoot := Node;
end;

procedure TDomTreeWalker.SetWhatToShow(const Value: TDomWhatToShow);
begin
  FWhatToShow := Value;
end;

function TDomTreeWalker.FindNextSibling(const OldNode: TDomNode): TDomNode;
var
  Accept: TDomFilterResult;
  NewNode: TDomNode;
begin
  Result := nil;
  if OldNode = Root then Exit;
  NewNode := OldNode.NextSibling;
  if Assigned(NewNode) then begin
    if NewNode.NodeType in FWhatToShow then begin
      if Assigned(FFilter)
        then Accept := FFilter.AcceptNode(NewNode)
        else Accept := filter_accept;
    end else Accept := filter_skip;
    case Accept of
      filter_reject:
        Result := FindNextSibling(NewNode);
      filter_skip:
        begin
          Result := FindFirstChild(NewNode);
          if not Assigned(Result) then
            Result := FindNextSibling(NewNode);
        end;
      filter_accept:
        Result := NewNode;
    end; {case ...}
  end else begin
    if not Assigned(OldNode.ParentNode)
      then begin Result := nil; Exit; end; // TreeWalker.Root not found!
    if OldNode.ParentNode.NodeType in FWhatToShow then begin
      if Assigned(FFilter)
        then Accept := FFilter.AcceptNode(OldNode.ParentNode)
        else Accept := filter_accept;
    end else Accept := filter_skip;
    case Accept of
      filter_reject, filter_skip:
        Result := FindNextSibling(OldNode.ParentNode);
      filter_accept:
        Result := nil;
    end; {case ...}
  end;
end;

function TDomTreeWalker.FindPreviousSibling(const OldNode: TDomNode): TDomNode;
var
  Accept: TDomFilterResult;
  NewNode: TDomNode;
begin
  Result := nil;
  if OldNode = Root then Exit;
  NewNode := OldNode.PreviousSibling;
  if Assigned(NewNode) then begin
    if NewNode.NodeType in FWhatToShow then begin
      if Assigned(FFilter)
        then Accept := FFilter.AcceptNode(NewNode)
        else Accept := filter_accept;
    end else Accept := filter_skip;
    case Accept of
      filter_reject:
        Result := FindPreviousSibling(NewNode);
      filter_skip:
        begin
          Result := FindLastChild(NewNode);
          if not Assigned(Result) then
            Result := FindPreviousSibling(NewNode);
        end;
      filter_accept:
        Result := NewNode;
    end; {case ...}
  end else begin
    if not Assigned(OldNode.ParentNode)
      then begin Result := nil; Exit; end; // TreeWalker.Root not found!
    if OldNode.ParentNode.NodeType in FWhatToShow then begin
      if Assigned(FFilter)
        then Accept := FFilter.AcceptNode(OldNode.ParentNode)
        else Accept := filter_accept;
    end else Accept := filter_skip;
    case Accept of
      filter_reject, filter_skip:
        Result := FindPreviousSibling(OldNode.ParentNode);
      filter_accept:
        Result := nil;
    end; {case ...}
  end;
end;

function TDomTreeWalker.FindParentNode(const OldNode: TDomNode): TDomNode;
var
  Accept: TDomFilterResult;
begin
  Result := nil;
  if OldNode = Root then Exit;
  Result := OldNode.ParentNode;
  if not Assigned(Result)
    then begin Result := nil; Exit; end; // TreeWalker.Root not found!
  if Result.NodeType in FWhatToShow then begin
    if Assigned(FFilter)
      then Accept := FFilter.AcceptNode(Result)
      else Accept := filter_accept;
  end else Accept := filter_skip;
  case Accept of
    filter_reject, filter_skip:
      Result := FindParentNode(Result);
  end;
end;

function TDomTreeWalker.FindFirstChild(const OldNode: TDomNode): TDomNode;
var
  I: Integer;
  NewNode: TDomNode;
  Accept: TDomFilterResult;
begin
  Result := nil;
  if (OldNode.NodeType = ntEntity_Reference_Node) and not FExpandEntityReferences
    then Exit;
  for I := 0 to Pred(Oldnode.ChildNodes.Length) do begin
    NewNode := Oldnode.ChildNodes.Item(I);
    if NewNode.NodeType in FWhatToShow then begin
      if Assigned(FFilter)
        then Accept := FFilter.AcceptNode(NewNode)
        else Accept := filter_accept;
    end else Accept := filter_skip;
    case Accept of
      filter_skip:
        Result := FindFirstChild(NewNode);
      filter_accept:
        Result := NewNode;
    end; {case ...}
    if Assigned(Result) then Break;
  end; {for ...}
end;

function TDomTreeWalker.FindLastChild(const OldNode: TDomNode): TDomNode;
var
  I: Integer;
  NewNode: TDomNode;
  Accept: TDomFilterResult;
begin
  Result := nil;
  if (OldNode.NodeType = ntEntity_Reference_Node) and not FExpandEntityReferences
    then Exit;
  for I := Pred(Oldnode.ChildNodes.Length) downto 0 do begin
    NewNode := Oldnode.ChildNodes.Item(I);
    if NewNode.NodeType in FWhatToShow then begin
      if Assigned(FFilter)
        then Accept := FFilter.AcceptNode(NewNode)
        else Accept := filter_accept;
    end else Accept := filter_skip;
    case Accept of
      filter_skip:
        Result := FindLastChild(NewNode);
      filter_accept:
        Result := NewNode;
    end; {case ...}
    if Assigned(Result) then Break;
  end; {for ...}
end;

function TDomTreeWalker.FindNextNode(OldNode: TDomNode): TDomNode;
var
  NewNode: TDomNode;
begin
  Result := FindFirstChild(OldNode);
  if OldNode = Root then Exit;
  if not Assigned(Result)then
    Result := FindNextSibling(OldNode);
  while not Assigned(Result) do begin
    NewNode := FindParentNode(OldNode);
    if not Assigned(NewNode) then Exit;  // No next node.
    Result := FindNextSibling(NewNode);
    OldNode := NewNode;
  end;
end;

function TDomTreeWalker.FindPreviousNode(const OldNode: TDomNode): TDomNode;
var
  NewNode: TDomNode;
begin
  Result := nil;
  if OldNode = Root then Exit;
  Result := FindPreviousSibling(OldNode);
  if Assigned(Result) then begin
    NewNode := FindLastChild(Result);
    if Assigned(NewNode) then Result := NewNode;
  end else
    Result := FindParentNode(OldNode);
end;

function TDomTreeWalker.ParentNode: TDomNode;
begin
  Result := FindParentNode(FCurrentNode);
  if Assigned(Result) then FCurrentNode:= Result;
end;

function TDomTreeWalker.FirstChild: TDomNode;
begin
  Result := FindFirstChild(FCurrentNode);
  if Assigned(Result) then FCurrentNode:= Result;
end;

function TDomTreeWalker.LastChild: TDomNode;
begin
  Result := FindLastChild(FCurrentNode);
  if Assigned(Result) then FCurrentNode:= Result;
end;

function TDomTreeWalker.PreviousSibling: TDomNode;
begin
  Result := FindPreviousSibling(FCurrentNode);
  if Assigned(Result) then FCurrentNode:= Result;
end;

function TDomTreeWalker.NextSibling: TDomNode;
begin
  Result := FindNextSibling(FCurrentNode);
  if Assigned(Result) then FCurrentNode:= Result;
end;

function TDomTreeWalker.PreviousNode: TDomNode;
begin
  Result := FindPreviousNode(FCurrentNode);
  if Assigned(Result) then FCurrentNode:= Result;
end;

function TDomTreeWalker.NextNode: TDomNode;
begin
  Result := FindNextNode(FCurrentNode);
  if Assigned(Result) then FCurrentNode:= Result;
end;



//++++++++++++++++++++++++++++ TDomNodeIterator +++++++++++++++++++++++++++++++
constructor TDomNodeIterator.Create(const Root: TDomNode;
                                    const WhatToShow: TDomWhatToShow;
                                    const NodeFilter: TDomNodeFilter;
                                    const EntityReferenceExpansion: Boolean);
begin
  if not Assigned(Root) then
    raise ENot_Supported_Err.Create('Not supported error.');
  inherited Create;
  FRoot := Root;
  FWhatToShow := WhatToShow;
  FFilter := NodeFilter;
  FExpandEntityReferences := EntityReferenceExpansion;
  FReferenceNode := Root;
  FInvalid := False;
  FPosition := posBefore;
end;

procedure TDomNodeIterator.HandleNodeEvent(const Node: TDomNode;
                                           const EventType: TDomNodeEvent);
var
  NewRefNode: TDomNode;
  NewPosition: TDomPosition;
  DP_Ref, DP_Root: TDomDocumentPosition;
begin
  if FInvalid then Exit;
  case EventType of
    neClearing: begin
      DP_Ref := FReferenceNode.CompareDocumentPosition(Node);
      if Document_Position_Following in DP_Ref then begin
        // The Iterator's reference node is affected.
        DP_Root := FRoot.CompareDocumentPosition(Node);
        if Document_Position_Following in DP_Root then begin
          // The Iterator's Root node is affected too,
          // so we must invalidate the Iterator:
          FReferenceNode := nil;
          FRoot := nil;
          FInvalid := True;
        end else begin
          // Reposition the Iterator:
          FReferenceNode := Node;
          FPosition := posAfter;
        end;
      end;
    end;
    neRemoving: begin
      DP_Root := FRoot.CompareDocumentPosition(Node);
      if Document_Position_Preceding in DP_Root then begin
        DP_Ref := FReferenceNode.CompareDocumentPosition(Node);
        if ( (Document_Position_Following in DP_Ref) or
             (Document_Position_Same_Node in DP_Ref) ) then begin

          NewRefNode := nil;
          NewPosition := FPosition;
          case FPosition of
            posBefore: begin
              NewRefNode := Node.NextSibling;
              if not Assigned(NewRefNode) then begin
                NewRefNode := FindPreviousNode(Node);
                NewPosition := posAfter;
              end;
            end;
            posAfter: begin
              NewRefNode := Node.NextSibling;
              if not Assigned(NewRefNode) then begin
                NewRefNode := FindPreviousNode(Node);
                NewPosition := posBefore;
              end;
            end;
          end; {case ...}
          if Assigned(NewRefNode) then begin
            FReferenceNode := NewRefNode;
            FPosition := NewPosition;
          end else begin
            // The Iterator is in an invalid state, so we invalidate it
            // (usually this should not happen, but we care for it anyway):
            FReferenceNode := nil;
            FRoot := nil;
            FInvalid := True;
          end;
        end;
      end;
    end;
  end; {case ...}
end;

procedure TDomNodeIterator.Detach;
begin
  FReferenceNode:= nil;
  FInvalid:= True;
end;

function TDomNodeIterator.FindNextNode(OldNode: TDomNode): TDomNode;
var
  NewNode: TDomNode;
begin
  with OldNode do
    if HasChildNodes
      and ( FExpandEntityReferences or (NodeType <> ntEntity_Reference_Node) )
      then Result := FirstChild
      else Result := NextSibling;
  while not Assigned(Result) do begin
    NewNode := OldNode.ParentNode;
    if not Assigned(NewNode) then Exit;  // No next node.
    Result := NewNode.NextSibling;
    OldNode := NewNode;
  end;
end;

function TDomNodeIterator.FindPreviousNode(const OldNode: TDomNode): TDomNode;
var
  NewNode: TDomNode;
begin
  with OldNode do begin
    Result := PreviousSibling;
    if Assigned(Result) then begin
      NewNode := Result;
      while Assigned(NewNode) do begin
        Result := NewNode;
        NewNode := NewNode.LastChild;
      end;
    end else Result := ParentNode;
  end;
end;

function TDomNodeIterator.NextNode: TDomNode;
var
  Accept: TDomFilterResult;
  NewNode: TDomNode;
begin
  NewNode := nil;
  if FInvalid then
    raise EInvalid_State_Err.Create('Invalid state error.');
  case FPosition of
    posBefore: begin
      FPosition := posAfter;
      NewNode := FReferenceNode;
    end;
    posAfter: begin
      NewNode := FindNextNode(FReferenceNode);
    end;
  end;
  repeat
    Accept := filter_accept;
    if Assigned(NewNode) then begin
      if NewNode.NodeType in FWhatToShow then begin
        if Assigned(FFilter)
          then Accept := FFilter.AcceptNode(NewNode);
      end else Accept := filter_skip;
      if not (Accept = filter_accept)
        then NewNode := FindNextNode(NewNode);
    end;
  until Accept = filter_accept;
  if Assigned(NewNode) then
    if not (NewNode.HasAsAncestor(Root) or (NewNode = Root)) then
      if (FReferenceNode.HasAsAncestor(Root) or (FReferenceNode = Root)) then
        NewNode := nil;
  if Assigned(NewNode) then
    FReferenceNode:= NewNode;
  Result := NewNode;
end;

function TDomNodeIterator.PreviousNode: TDomNode;
var
  Accept: TDomFilterResult;
  NewNode: TDomNode;
begin
  NewNode := nil;
  if FInvalid then
    raise EInvalid_State_Err.Create('Invalid state error.');
  case FPosition of
    posBefore: begin
      NewNode := FindPreviousNode(FReferenceNode);
    end;
    posAfter: begin
      FPosition := posBefore;
      NewNode := FReferenceNode;
    end;
  end;
  repeat
    Accept := filter_accept;
    if Assigned(NewNode) then begin
      if NewNode.NodeType in FWhatToShow then begin
        if Assigned(FFilter)
          then Accept := FFilter.AcceptNode(NewNode);
      end else Accept := filter_skip;
      if not (Accept = filter_accept)
        then NewNode := FindPreviousNode(NewNode);
    end;
  until Accept = filter_accept;
  if Assigned(NewNode) then
    if not (NewNode.HasAsAncestor(Root) or (NewNode = Root)) then
      if (FReferenceNode.HasAsAncestor(Root) or (FReferenceNode = Root)) then
        NewNode := nil;
  if Assigned(NewNode) then FReferenceNode:= NewNode;
  Result := NewNode;
end;



//++++++++++++++++++++++++++++ TDomNodeList +++++++++++++++++++++++++++++++
constructor TDomNodeList.Create(const NodeList: TList);
begin
  inherited Create;
  FNodeList := NodeList;
end;

function TDomNodeList.GetLength: Integer;
begin
  Result := FNodeList.Count;
end;

function TDomNodeList.IndexOf(const Node: TDomNode): Integer;
begin
  Result := FNodeList.IndexOf(Node);
end;

function TDomNodeList.Item(const Index: Integer): TDomNode;
begin
  if (Index < 0) or (Index >= FNodeList.Count)
    then Result := nil
    else Result := TDomNode(FNodeList.List^[Index]);
end;



//++++++++++++++++++++++++ TDomElementsNodeList ++++++++++++++++++++++++++
constructor TDomElementsNodeList.Create(const QueryName: WideString;
                                        const StartElement: TDomNode);
begin
  inherited Create(nil);
  FQueryName:= QueryName;
  FStartElement:= StartElement;
end;

function TDomElementsNodeList.GetLength: Integer;
var
  AktNode,NewNode: TDomNode;
  Level: Integer;
begin
  Result := 0;
  if not Assigned(FStartElement) then Exit;
  Level := 0;
  AktNode := FStartElement;
  if AktNode.NodeType = ntElement_Node then
    if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then
      Inc(Result);
  repeat
    if AktNode.HasChildNodes
      then begin NewNode := AktNode.FirstChild; Inc(Level); end
      else NewNode := AktNode.NextSibling;
    while not Assigned(NewNode) do begin
      Dec(Level);
      if Level < 1 then Break;
      AktNode := AktNode.ParentNode;
      NewNode := AktNode.NextSibling;
    end;
    if Level < 1 then Break;
    AktNode := NewNode;
    if AktNode.NodeType = ntElement_Node then
      if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then
        Inc(Result);
  until Level < 1;
end;

function TDomElementsNodeList.IndexOf(const Node: TDomNode): Integer;
var
  AktNode, NewNode: TDomNode;
  Level, I: Integer;
begin
  Result := -1;
  if not Assigned(FStartElement) then Exit;
  if not (Node is TDomNode) then Exit;
  if Node.NodeType <> ntElement_Node then Exit;
  I := -1;
  Level := 0;
  AktNode := FStartElement;
  repeat
    if AktNode.HasChildNodes
      then begin NewNode := AktNode.FirstChild; Inc(Level); end
      else NewNode := AktNode.NextSibling;
    while not Assigned(NewNode) do begin
      Dec(Level);
      if Level < 1 then Break;
      AktNode:= AktNode.ParentNode;
      NewNode := AktNode.NextSibling;
    end;
    if Level < 1 then Break;
    AktNode := NewNode;
    if AktNode.NodeType = ntElement_Node then
      if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then begin
        Inc(I);
        if AktNode = Node then begin Result := I; Break; end;
      end;
  until Level < 1;
end;

function TDomElementsNodeList.Item(const Index: Integer): TDomNode;
var
  AktNode, NewNode: TDomNode;
  Level, I: Integer;
begin
  Result := nil;
  if not Assigned(FStartElement) then Exit;
  if (Index < 0) then Exit;
  I := -1;
  Level := 0;
  AktNode := FStartElement;
  repeat
    if AktNode.HasChildNodes
      then begin NewNode := AktNode.FirstChild; Inc(Level); end
      else NewNode := AktNode.NextSibling;
    while not Assigned(NewNode) do begin
      Dec(Level);
      if Level < 1 then Break;
      AktNode := AktNode.ParentNode;
      NewNode := AktNode.NextSibling;
    end;
    if Level < 1 then Break;
    AktNode := NewNode;
    if AktNode.NodeType = ntElement_Node then
      if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then begin
        Inc(I);
        if I = Index then begin Result := AktNode; Break; end;
      end;
  until Level < 1;
end;



//+++++++++++++++++++++ TDomElementsNodeListNS ++++++++++++++++++++++++++
constructor TDomElementsNodeListNS.Create(const QueryNamespaceURI,
                                                QueryLocalName: WideString;
                                          const StartElement: TDomNode);
begin
  inherited Create(nil);
  FQueryNamespaceURI := QueryNamespaceURI;
  FQueryLocalName := QueryLocalName;
  FStartElement := StartElement;
end;

function TDomElementsNodeListNS.GetLength: Integer;
var
  AktNode, NewNode: TDomNode;
  Level: Integer;
begin
  Result := 0;
  if not Assigned(FStartElement) then Exit;
  Level := 0;
  AktNode := FStartElement;
  repeat
    if AktNode.HasChildNodes
      then begin NewNode := AktNode.FirstChild; Inc(Level); end
      else NewNode := AktNode.NextSibling;
    while not Assigned(NewNode) do begin
      Dec(Level);
      if Level < 1 then Break;
      AktNode := AktNode.ParentNode;
      NewNode := AktNode.NextSibling;
    end;
    if Level < 1 then Break;
    AktNode:= NewNode;
    if AktNode.NodeType = ntElement_Node then
      if ((AktNode.NamespaceURI = FQueryNamespaceURI) or (FQueryNamespaceURI = '*'))
        and ((AktNode.LocalName = FQueryLocalName) or (FQueryLocalName = '*'))
          then Inc(Result);
  until Level < 1;
end;

function TDomElementsNodeListNS.IndexOf(const Node: TDomNode): Integer;
var
  AktNode, NewNode: TDomNode;
  Level, I: Integer;
begin
  Result := -1;
  if not Assigned(FStartElement) then Exit;
  if not (Node is TDomNode) then Exit;
  if Node.NodeType <> ntElement_Node then Exit;
  I := -1;
  Level := 0;
  AktNode := FStartElement;
  repeat
    if AktNode.HasChildNodes
      then begin NewNode := AktNode.FirstChild; Inc(Level); end
      else NewNode := AktNode.NextSibling;
    while not Assigned(NewNode) do begin
      Dec(Level);
      if Level < 1 then Break;
      AktNode := AktNode.ParentNode;
      NewNode := AktNode.NextSibling;
    end;
    if Level < 1 then Break;
    AktNode := NewNode;
    if AktNode.NodeType = ntElement_Node then
      if ((AktNode.NamespaceURI = FQueryNamespaceURI) or (FQueryNamespaceURI = '*'))
        and ((AktNode.LocalName = FQueryLocalName) or (FQueryLocalName = '*'))
          then begin
            Inc(I);
            if AktNode = Node then begin Result := I; Break; end;
          end;
  until Level < 1;
end;

function TDomElementsNodeListNS.Item(const Index: Integer): TDomNode;
var
  AktNode, NewNode: TDomNode;
  Level, I: Integer;
begin
  Result := nil;
  if not Assigned(FStartElement) then Exit;
  if (Index < 0) then Exit;
  I := -1;
  Level := 0;
  AktNode := FStartElement;
  repeat
    if AktNode.HasChildNodes
      then begin NewNode := AktNode.FirstChild; Inc(Level); end
      else NewNode := AktNode.NextSibling;
    while not Assigned(NewNode) do begin
      Dec(Level);
      if Level < 1 then Break;
      AktNode:= AktNode.ParentNode;
      NewNode := AktNode.NextSibling;
    end;
    if Level < 1 then Break;
    AktNode:= NewNode;
    if AktNode.NodeType = ntElement_Node then
      if ((AktNode.NamespaceURI = FQueryNamespaceURI) or (FQueryNamespaceURI = '*'))
        and ((AktNode.LocalName = FQueryLocalName) or (FQueryLocalName = '*'))
          then begin
            Inc(I);
            if I = Index then begin Result := AktNode; Break; end;
          end;
  until Level < 1;
end;



//+++++++++++++++++++++++ TDomOwnerNamedNodeMap +++++++++++++++++++++++++++
constructor TDomOwnerNamedNodeMap.Create(const AItemClass: TDomCustomNodeClass);
begin
  FItemClass := AItemClass;
  FNodeList := TUtilsWideStringList.Create;
  FNodeList.Duplicates := dupError;
  FNodeList.Sorted:= True;
end;

destructor TDomOwnerNamedNodeMap.Destroy;
begin
  Clear;
  FNodeList.Free;
  inherited;
end;

function TDomOwnerNamedNodeMap.Add(const Node: TDomCustomNode): Integer;
begin
  if not (Node is ItemClass) then
    raise EHierarchy_Request_Err.Create('Hierarchy request error.');
  Result := FNodeList.AddObject(Node.NodeName, Node);
end;

procedure TDomOwnerNamedNodeMap.Clear;
var
  Index: Integer;
begin
  for Index := 0 to Pred(FNodeList.Count) do
    FNodeList.objects[Index].Free;
  FNodeList.Clear;
end;

procedure TDomOwnerNamedNodeMap.Delete(const Index: Integer);
begin
  if (Index < 0) or (Index >= Count) then
    raise EStringListError.CreateFmt('List index out of bounds (%d)', [Index]);
  TDomCustomNode(FNodeList.Objects[Index]).Free;
  FNodeList.Delete(Index);
end;

function TDomOwnerNamedNodeMap.ExtractItem(const Node: TDomCustomNode): TDomCustomNode;
var
  Index: Integer;
begin
  Index := IndexOfItem(Node);
  if Index = -1 then
    raise EStringListError.Create('Item not found');
  Result := Items[Index];
  FNodeList.Delete(Index);
end;

function TDomOwnerNamedNodeMap.GetCount: Integer;
begin
  Result := FNodeList.Count;
end;

function TDomOwnerNamedNodeMap.GetItems(Index: Integer): TDomCustomNode;
begin
  Result := TDomCustomNode(FNodeList.Objects[Index]);
end;

function TDomOwnerNamedNodeMap.GetNamedItem(const Name: WideString): TDomCustomNode;
var
  Index: Integer;
begin
  Index := IndexOfNamedItem(Name);
  if Index = -1
    then Result := nil
    else Result := Items[Index];
end;

function TDomOwnerNamedNodeMap.HasNamedItem(const Name: WideString): Boolean;
begin
  Result := IndexOfNamedItem(Name) > -1;
end;

function TDomOwnerNamedNodeMap.IndexOfItem(const Node: TDomCustomNode): Integer;
var
  Index: Integer;
begin
  for Index := 0 to Pred(FNodeList.Count) do
    if FNodeList.objects[Index] = Node then begin
      Result := Index;
      Exit;
    end;
  Result := -1;
end;

function TDomOwnerNamedNodeMap.IndexOfNamedItem(const Name: WideString): Integer;
begin
  Result := FNodeList.IndexOf(Name);
end;

function TDomOwnerNamedNodeMap.RemoveItem(const Node: TDomCustomNode): Integer;
begin
  Result := IndexOfItem(Node);
  if Result > -1 then begin
    FNodeList.Delete(Result);
    Node.Free;
  end;
end;

function TDomOwnerNamedNodeMap.RemoveNamedItem(const Name: WideString): Integer;
begin
  Result := IndexOfNamedItem(Name);
  if Result > -1 then begin
    TDomCustomNode(FNodeList.Objects[Result]).Free;
    FNodeList.Delete(Result);
  end;
end;




//+++++++++++++++++++++++++ TDomNamedNodeMap +++++++++++++++++++++++++++++
constructor TDomNamedNodeMap.Create(const AOwner: TDomNode;
                                    const NodeList: TList;
                                    const AllowedNTs: TDomWhatToShow;
                                    const DefaultNamespaceAware: Boolean);
begin
  inherited Create(NodeList);
  FOwnerNode := AOwner;
  FAllowedNodeTypes := AllowedNTs;
  FDefaultNamespaceAware := DefaultNamespaceAware;
end;

procedure TDomNamedNodeMap.CheckAllowedNodeType(const Node: TDomNode);
begin
  if not (Node.NodeType in FAllowedNodeTypes) then
    raise EHierarchy_Request_Err.Create('Hierarchy request error.');
end;

procedure TDomNamedNodeMap.CheckHasNode(const Node: TDomNode);
begin
  if FNodeList.IndexOf(Node) = -1 then
    raise ENot_Found_Err.Create('Node not found error.');
end;

procedure TDomNamedNodeMap.CheckNamespaceAware;
begin
  if not NamespaceAware then
    raise ENamespace_Err.Create('Namespace error.');
end;

procedure TDomNamedNodeMap.CheckNotInUse(const Node: TDomNode);
begin
  if Assigned(Node.ParentNode) then
    raise EInuse_Err.Create('Inuse node error.');
  if Node.NodeType = ntAttribute_Node then
    if Assigned((Node as TDomAttr).FOwnerMap) then
      if (Node as TDomAttr).FOwnerMap <> Self then
        raise EInuse_Err.Create('Inuse attribute error.');
end;

procedure TDomNamedNodeMap.CheckNotNamespaceAware;
begin
  if NamespaceAware then
    raise ENamespace_Err.Create('Namespace error.');
end;

procedure TDomNamedNodeMap.CheckNotReadOnly;
begin
  if ReadOnly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
end;

procedure TDomNamedNodeMap.CheckSameRootDocument(const Node: TDomNode);
begin
  if OwnerNode.RootDocument <> Node.RootDocument then
    raise EWrong_Document_Err.Create('Wrong document error.');
end;

function TDomNamedNodeMap.GetNamedItem(const Name: WideString): TDomNode;
var
  I: Integer;
begin
  CheckNotNamespaceAware;
  Result := nil;
  for I := 0 to Pred(FNodeList.Count) do
    if TDomNode(FNodeList[I]).NodeName = Name then begin
      Result := TDomNode(FNodeList[I]);
      Break;
    end;
end;

function TDomNamedNodeMap.GetNamedItemNS(const NamespaceURI,
                                               LocalName: WideString): TDomNode;
var
  I: Integer;
begin
  CheckNamespaceAware;
  Result := nil;
  for I := 0 to Pred(FNodeList.Count) do
    if (TDomNode(FNodeList[I]).NamespaceURI = NamespaceURI)
      and (TDomNode(FNodeList[I]).LocalName = LocalName) then begin
      Result := TDomNode(FNodeList[I]);
      Break;
    end;
end;

function TDomNamedNodeMap.GetNamespaceAware: Boolean;
begin
  if Assigned(OwnerNode)
    then Result := OwnerNode.IsNamespaceNode
    else Result := FDefaultNamespaceAware;
end;

function TDomNamedNodeMap.GetReadOnly: Boolean;
begin
  if Assigned(OwnerNode)
    then Result := OwnerNode.IsReadonly
    else Result := False;
end;

procedure TDomNamedNodeMap.InternalAdd(const Node: TDomNode);
begin
  FNodeList.Add(Node);
  if (Node.NodeType = ntAttribute_Node)
    then (Node as TDomAttr).FOwnerMap := Self;
end;

procedure TDomNamedNodeMap.InternalRemove(const Node: TDomNode);
begin
  FNodeList.Remove(Node);
  if (Node.NodeType = ntAttribute_Node)
    then (Node as TDomAttr).FOwnerMap := nil;
end;

function TDomNamedNodeMap.RemoveItem(const Arg: TDomNode): TDomNode;
begin
  CheckNotReadOnly;
  CheckHasNode(Arg);
  Result := Arg;
  InternalRemove(Arg);
end;

function TDomNamedNodeMap.RemoveNamedItem(const Name: WideString): TDomNode;
begin
  CheckNotNamespaceAware;
  CheckNotReadOnly;
  Result := GetNamedItem(Name);
  if not Assigned(Result) then
    raise ENot_Found_Err.Create('Node not found error.');
  InternalRemove(Result);
end;

function TDomNamedNodeMap.RemoveNamedItemNS(const NamespaceURI,
                                                  LocalName: WideString): TDomNode;
begin
  CheckNamespaceAware;
  CheckNotReadOnly;
  Result := GetNamedItemNS(NamespaceURI, LocalName);
  if not Assigned(Result) then
    raise ENot_Found_Err.Create('Node not found error.');
  InternalRemove(Result);
end;

function TDomNamedNodeMap.SetNamedItem(const Arg: TDomNode): TDomNode;
begin
  CheckNotNamespaceAware;
  CheckNotReadOnly;
  CheckSameRootDocument(Arg);
  CheckAllowedNodeType(Arg);
  CheckNotInUse(Arg);

  Result := GetNamedItem(Arg.NodeName);
  if Result = Arg then begin  // Is Arg already in the map?
    Result := nil;
  end else begin
    if Assigned(Result) then
      InternalRemove(Result);
    InternalAdd(Arg);
  end;
end;

function TDomNamedNodeMap.SetNamedItemNS(const Arg: TDomNode): TDomNode;
begin
  CheckNamespaceAware;
  CheckNotReadOnly;
  CheckSameRootDocument(Arg);
  CheckAllowedNodeType(Arg);
  CheckNotInUse(Arg);

  Result := GetNamedItemNS(Arg.NamespaceURI, Arg.LocalName);
  if Result = Arg then begin  // Is Arg already in the map?
    Result := nil;
  end else begin
    if Assigned(Result)
      then InternalRemove(Result);
    InternalAdd(Arg);
  end;
end;



//+++++++++++++++++++++++++++ TDomCustomNode ++++++++++++++++++++++++++++++
procedure TDomCustomNode.RaiseException(const E: ExceptClass);
begin
  if E = EHierarchyRequestError then
    raise EHierarchy_Request_Err.Create('EHierarchy request error.')

  else if E = ENoModificationAllowedError then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed.')

  else if E = ENotAssignedError then
    raise ENot_Supported_Err.Create('Node not specified.')

  else if E = ENotFoundError then
    raise ENot_Found_Err.Create('Node not found.')

  else if E = EWrongOwnerError then
    raise EWrong_Document_Err.Create('Wrong document.')

  else
    raise E.Create(E.ClassName);
end;



//++++++++++++++++++++++++++++++ TDomNode +++++++++++++++++++++++++++++++++
constructor TDomNode.Create(const AOwner: TCustomOwnedObject);
begin
  inherited Create(AOwner);
  FNodeList := TDomNodeList.Create(Items);
  FAllowedChildTypes := [ ntElement_Node,
                          ntText_Node,
                          ntCDATA_Section_Node,
                          ntEntity_Reference_Node,
                          ntProcessing_Instruction_Node,
                          ntComment_Node,
                          ntDocument_Type_Decl_Node,
                          ntDocument_Fragment_Node ];
  FIsNamespaceNode := False;
  if AOwner is TDomCustomDocument
    then FOwnerDocument := AOwner as TDomCustomDocument
    else FOwnerDocument := nil;
end;

destructor TDomNode.Destroy;
var
  I: Integer;
  UserDataEvent: TDomUserDataEvent;
begin
  // Call user data event handlers:
  if Assigned(FUserData) then
    with FUserData do
      for I := 0 to Pred(Count) do begin
        @UserDataEvent := Pointer(FUserDataHandlers[I]);
        if Assigned(UserDataEvent) then
          UserDataEvent(OT_NODE_DESTROYED, WideStrings[I], Objects[I], nil, nil);
      end;

  FNodeList.Free;
  FUserData.Free;
  FUserDataHandlers.Free;
  inherited Destroy;
end;

function TDomNode.AppendChild(const NewChild: TDomNode): TDomNode;
begin
  CheckTypeAllowed(NewChild);

  if NewChild is TDomDocumentFragment then begin

    CheckAssigned(NewChild);
    CheckSameOwner(NewChild);
    while NewChild.HasChildNodes do
      Append(NewChild.ChildNodes.Item(0));
    Result := NewChild;

  end else Result := (Append(NewChild) as TDomNode);
end;

procedure TDomNode.CheckTypeAllowed(const Node: TDomNode);
begin
  if Assigned(Node) then
    if not (Node.NodeType in FAllowedChildTypes) then
      raise EHierarchy_Request_Err.CreateFmt(
        'Nodes of type %s are not allowed as children of nodes of type %s',
        [Node.ClassName, ClassName]
      );
end;

procedure TDomNode.Clear;
begin
  inherited Clear;
end;

function TDomNode.CloneNode(const Deep: Boolean): TDomNode;
var
  I: Integer;
  UserDataEvent: TDomUserDataEvent;
begin
  Result := RootDocument.ImportNode2(Self, Deep);

  // Call user data event handlers:
  if Assigned(Result) and Assigned(FUserData) then
    with FUserData do
      for I := 0 to Pred(Count) do begin
        @UserDataEvent := Pointer(FUserDataHandlers[I]);
        if Assigned(UserDataEvent) then
          UserDataEvent(OT_NODE_CLONED, WideStrings[I], Objects[I], Self, Result);
      end;
end;

function TDomNode.CompareDocumentPosition(const Other: TDomNode): TDomDocumentPosition;

  procedure BuildAncestorList(Node: TDomNode;
                              const Ancestors: TList);
  begin
    Ancestors.Clear;
    while True do begin

      Ancestors.Insert(0, Node);

      if Assigned(Node.ParentNode) then begin
        Node := Node.ParentNode;
      end else begin
        case Node.NodeType of
          ntAttribute_Node:
            if Assigned(TDomAttr(Node).OwnerElement)
              then Node := TDomAttr(Node).OwnerElement
              else Break;
          ntXPath_Namespace_Node:
            if Assigned(TDomXPathNamespace(Node).OwnerElement)
              then Node := TDomXPathNamespace(Node).OwnerElement
              else Break;
        else
          Break;
        end;
      end;

    end; {while ...}
  end;

var
  SelfAncestors, OtherAncestors: TList;
  I: Integer;
begin
  if not Assigned(Other) then
    raise ENot_Supported_Err.Create('Not supported error.');
  if Other = Self then begin
    Result := [Document_Position_Equivalent, Document_Position_Same_Node];
    Exit;
  end;

  SelfAncestors := TList.Create;
  OtherAncestors := TList.Create;
  try
    BuildAncestorList(Self, SelfAncestors);
    BuildAncestorList(Other, OtherAncestors);

    // Disconnected?
    if SelfAncestors[0] <> OtherAncestors[0] then begin
      Result := [Document_Position_Disconnected];
      Exit;
    end;

    // Reduce list to the last common ancestor:
    SelfAncestors.Add(nil);   // Add stop-nil
    OtherAncestors.Add(nil);  // Add stop-nil
    while SelfAncestors[1] = OtherAncestors[1] do begin
      SelfAncestors.Delete(0);
      OtherAncestors.Delete(0);
      // Remark: No run over, because 'self' and 'other' are not identical.
    end;

    // Is 'other' ancestor?
    if OtherAncestors.Count = 2 then begin // Remark: 2, because 'other' and nil are in the list.
      Result := [Document_Position_Contains, Document_Position_Preceding];
      Exit;
    end;

    // Is 'other' descendant?
    if SelfAncestors.Count = 2 then begin
      Result := [Document_Position_Contained_By, Document_Position_Following];
      Exit;
    end;

    // XPathNamespaces involved?
    if (TDomNode(SelfAncestors[1]).NodeType = ntXPath_Namespace_Node) then begin
      if (TDomNode(OtherAncestors[1]).NodeType = ntXPath_Namespace_Node)
        then Result := [Document_Position_Equivalent]
        else Result := [Document_Position_Following];
      Exit;
    end;
    if (TDomNode(OtherAncestors[1]).NodeType = ntXPath_Namespace_Node) then begin
      Result := [Document_Position_Preceding];
      Exit;
    end;

    // Attributes involved?
    if (TDomNode(SelfAncestors[1]).NodeType = ntAttribute_Node) then begin
      if (TDomNode(OtherAncestors[1]).NodeType = ntAttribute_Node)
        then Result := [Document_Position_Equivalent]
        else Result := [Document_Position_Following];
      Exit;
    end;
    if (TDomNode(OtherAncestors[1]).NodeType = ntAttribute_Node) then begin
      Result := [Document_Position_Preceding];
      Exit;
    end;

    // No Attributes or XPathNamespaces.  Determine the order of the nodes.
    with TDomNode(SelfAncestors[0]).ChildNodes do begin
      for I := 0 to Pred(Length) do begin
        if Item(I) = SelfAncestors[1] then begin
          Result := [Document_Position_Following];
          Exit;
        end;
        if Item(I) = OtherAncestors[1] then begin
          Result := [Document_Position_Preceding];
          Exit;
        end;
      end;
    end; {with ...}

  finally
    SelfAncestors.Free;
    OtherAncestors.Free;
  end;
end;

procedure TDomNode.DoAfterAddition(const Node: TCustomOwnedNode);
begin
  if Assigned(RootDocument) then
    RootDocument.DoNodeInserted(Node as TDomNode);
end;

procedure TDomNode.DoBeforeClear;
begin
  if Assigned(RootDocument) then
    RootDocument.DoNodeClearing(Self);
end;

procedure TDomNode.DoBeforeRemoval(const Node: TCustomOwnedNode);
begin
  if Assigned(RootDocument)
    then RootDocument.DoNodeRemoving(Node as TDomNode);
end;

function TDomNode.EvaluateToBoolean(const Expression: WideString): Boolean;
var
  XPathExpression: TXPathExpression;
begin
  XPathExpression := TXPathExpression.Create(nil);
  try
    XPathExpression.Expression := Expression;
    XPathExpression.ContextNode := Self;
    XPathExpression.Evaluate;
    Result := XPathExpression.ResultAsBoolean;
  finally
    XPathExpression.Free;
  end;
end;

function TDomNode.EvaluateToNode(const Expression: WideString): TDomNode;
var
  XPathExpression: TXPathExpression;
begin
  XPathExpression := TXPathExpression.Create(nil);
  try
    XPathExpression.Expression := Expression;
    XPathExpression.ContextNode := Self;
    XPathExpression.Evaluate;
    Result := XPathExpression.ResultNode(0); // Remark: Returns nil, if there exists no resultNode(0).
  finally
    XPathExpression.Free;
  end;
end;

function TDomNode.EvaluateToNumber(const Expression: WideString): Double;
var
  XPathExpression: TXPathExpression;
begin
  XPathExpression := TXPathExpression.Create(nil);
  try
    XPathExpression.Expression := Expression;
    XPathExpression.ContextNode := Self;
    XPathExpression.Evaluate;
    Result := XPathExpression.ResultAsNumber;
  finally
    XPathExpression.Free;
  end;
end;

function TDomNode.EvaluateToWideString(const Expression: WideString): WideString;
var
  XPathExpression: TXPathExpression;
begin
  XPathExpression := TXPathExpression.Create(nil);
  try
    XPathExpression.Expression := Expression;
    XPathExpression.ContextNode := Self;
    XPathExpression.Evaluate;
    Result := XPathExpression.ResultAsWideString;
  finally
    XPathExpression.Free;
  end;
end;

function TDomNode.FindFirstChildElement: TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := FirstChild;
  while Assigned(NodeToTest) do begin
    if NodeToTest.NodeType = ntElement_Node then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.NextSibling;
  end;
end;

function TDomNode.FindLastChildElement: TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := LastChild;
  while Assigned(NodeToTest) do begin
    if NodeToTest.NodeType = ntElement_Node then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.PreviousSibling;
  end;
end;

function TDomNode.FindNextSiblingElement: TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := NextSibling;
  while Assigned(NodeToTest) do begin
    if NodeToTest.NodeType = ntElement_Node then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.NextSibling;
  end;
end;

function TDomNode.FindParentElement: TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := ParentNode;
  while Assigned(NodeToTest) do begin
    if NodeToTest.NodeType = ntElement_Node then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.ParentNode;
  end;
end;

function TDomNode.FindPreviousSiblingElement: TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := PreviousSibling;
  while Assigned(NodeToTest) do begin
    if NodeToTest.NodeType = ntElement_Node then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.PreviousSibling;
  end;
end;

function TDomNode.GetAbsoluteIndex: Integer;
var
  N: TDomNode;
begin
  N := PreviousNode;
  if Assigned(N) then begin
    Result := N.AbsoluteIndex;
    if Result > -1 then Inc(Result);
  end else Result := -1;
end;

function TDomNode.GetAttributes: TDomNamedNodeMap;
begin
  Result := nil;
end;

function TDomNode.GetBaseUri: WideString;
var
  Attr: TDomAttr;
  UriAnalyzer: TUriWideStrAnalyzer;
  Uri1, Uri2: WideString;
begin
  case NodeType of
  ntElement_Node: begin
    if IsNamespaceNode
      then Attr := TDomElement(Self).GetAttributeNodeNS('http://www.w3.org/XML/1998/namespace','base')
      else Attr := TDomElement(Self).GetAttributeNode('xml:base');
    if Assigned(Attr) then begin

      Uri1 := Attr.Value;
      UriAnalyzer := TUriWideStrAnalyzer.Create;
      try
        UriAnalyzer.SetUriReference(Uri1);
        if UriAnalyzer.HasUriScheme then begin
          // absolute URI --> we are done
          Result := Attr.Value;
        end else begin
          Uri2 := Attr.BaseUri;
          ResolveRelativeUriWideStr(Uri2, Uri1, Result);
              // Remark: Returns an empty Result if ResolveRelativeUriWideStr attempt fails.
        end;
      finally
        UriAnalyzer.Free;
      end;

    end else begin
      if Assigned(ParentNode)
        then Result := ParentNode.BaseUri
        else Result := '';
    end; {if ... else ...}
  end;
  ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
  ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Type_Decl_Node:
    if Assigned(ParentNode)
      then Result := ParentNode.BaseUri
      else Result := '';
  ntAttribute_Node: begin
    Result := '';
    if Assigned(TDomAttr(Self).OwnerElement) then begin
      if ( (NamespaceURI = 'http://www.w3.org/XML/1998/namespace') and ( LocalName = 'base') )
         or ( (NamespaceURI = '') and ( NodeName = 'xml:base') ) then begin
        if Assigned(TDomAttr(Self).OwnerElement.ParentNode)
          then Result := TDomAttr(Self).OwnerElement.ParentNode.BaseUri;
      end else Result := TDomAttr(Self).OwnerElement.BaseUri;
    end;
  end;
  else
    Result := '';
  end;
end;

function TDomNode.GetChildNodes: TDomNodeList;
begin
  Result := FNodeList;
end;

function TDomNode.GetDocument: TDomCustomDocument;
begin
  Result := FOwnerDocument;
end;

function TDomNode.GetExpandedName: WideString;
begin
  Result := '';
end;

function TDomNode.GetFirstChild: TDomNode;
begin
  Result := (inherited GetFirstChild as TDomNode);
end;

function TDomNode.GetFirstChildElement(const Name: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := FirstChild;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node) and (NodeToTest.NodeName = Name) then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.NextSibling;
  end;
end;

function TDomNode.GetFirstChildElementNS(const NamespaceURI,
                                               LocalName: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := FirstChild;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node)
      and (NodeToTest.NamespaceURI = NamespaceURI)
      and (NodeToTest.LocalName = LocalName)
      then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.NextSibling;
  end;
end;

function TDomNode.GetLanguage: WideString;
var
  Attr: TDomAttr;
begin
  case NodeType of
  ntElement_Node: begin
    if IsNamespaceNode
      then Attr := TDomElement(Self).GetAttributeNodeNS('http://www.w3.org/XML/1998/namespace','lang')
      else Attr := TDomElement(Self).GetAttributeNode('xml:lang');
    if Assigned(Attr) then begin
      Result := Attr.Value;
    end else begin
      if Assigned(ParentNode)
        then Result := ParentNode.Language
        else Result := '';
    end; {if ... else ...}
  end;
  ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
  ntProcessing_Instruction_Node, ntComment_Node:
    if Assigned(ParentNode)
      then Result := ParentNode.Language
      else Result := '';
  ntAttribute_Node:
    if Assigned(TDomAttr(Self).OwnerElement)
      then Result := TDomAttr(Self).OwnerElement.Language
      else Result := '';
  ntXPath_Namespace_Node:
    if Assigned(TDomXPathNamespace(Self).OwnerElement)
      then Result := TDomXPathNamespace(Self).OwnerElement.Language
      else Result := '';
  else
    Result := '';
  end;
end;

function TDomNode.GetLastChild: TDomNode;
begin
  Result := (inherited GetLastChild as TDomNode);
end;

function TDomNode.GetLastChildElement(const Name: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := LastChild;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node) and (NodeToTest.NodeName = Name) then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.PreviousSibling;
  end;
end;

function TDomNode.GetLastChildElementNS(const NamespaceURI,
                                              LocalName: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := LastChild;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node)
      and (NodeToTest.NamespaceURI = NamespaceURI)
      and (NodeToTest.LocalName = LocalName)
      then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.PreviousSibling;
  end;
end;

function TDomNode.GetLevel: Integer;
begin
  if Assigned(ParentNode) then begin
    Result := ParentNode.Level;
    if Result > -1 then Inc(Result);
  end else Result := -1;
end;

function TDomNode.GetLocalName: WideString;
begin
  Result := '';
end;

function TDomNode.GetNamespaceURI: WideString;
begin
  Result := '';
end;

function TDomNode.GetNextSibling: TDomNode;
begin
  Result := (inherited GetNextSibling as TDomNode);
end;

function TDomNode.GetNextSiblingElement(const Name: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := NextSibling;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node) and (NodeToTest.NodeName = Name) then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.NextSibling;
  end;
end;

function TDomNode.GetNextSiblingElementNS(const NamespaceURI,
                                                LocalName: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := NextSibling;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node)
      and (NodeToTest.NamespaceURI = NamespaceURI)
      and (NodeToTest.LocalName = LocalName)
      then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.NextSibling;
  end;
end;

function TDomNode.GetNodeName: WideString;
begin
  Result := '';
end;

function TDomNode.GetNodeType: TDomNodeType;
begin
  Result := ntUnknown;
end;

function TDomNode.GetNodeValue: WideString;
begin
  Result := FNodeValue;
end;

function TDomNode.GetParentElement(const Name: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := ParentNode;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node) and (NodeToTest.NodeName = Name) then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.ParentNode;
  end;
end;

function TDomNode.GetParentElementNS(const NamespaceURI,
                                           LocalName: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := ParentNode;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node)
      and (NodeToTest.NamespaceURI = NamespaceURI)
      and (NodeToTest.LocalName = LocalName)
      then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.ParentNode;
  end;
end;

function TDomNode.GetParentNode: TDomNode;
begin
  Result := (inherited GetParent as TDomNode);
end;

function TDomNode.GetPrefix: WideString;
begin
  Result := '';
end;

function TDomNode.GetPreviousSibling: TDomNode;
begin
  Result := (inherited GetPreviousSibling as TDomNode);
end;

function TDomNode.GetPreviousSiblingElement(const Name: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := PreviousSibling;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node) and (NodeToTest.NodeName = Name) then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.PreviousSibling;
  end;
end;

function TDomNode.GetPreviousSiblingElementNS(const NamespaceURI,
                                                    LocalName: WideString): TDomElement;
var
  NodeToTest: TDomNode;
begin
  Result := nil;
  NodeToTest := PreviousSibling;
  while Assigned(NodeToTest) do begin
    if (NodeToTest.NodeType = ntElement_Node)
      and (NodeToTest.NamespaceURI = NamespaceURI)
      and (NodeToTest.LocalName = LocalName)
      then begin
      Result := (NodeToTest as TDomElement);
      Exit;
    end;
    NodeToTest := NodeToTest.PreviousSibling;
  end;
end;

function TDomNode.GetUserData(const Key: WideString): TObject;
var
  Index: Integer;
begin
  if Assigned(FUserData) then begin
    Index := FUserData.IndexOf(Key);
    if Index = -1
      then Result := nil
      else Result := FUserData.Objects[Index];
  end else Result := nil;
end;

function TDomNode.GetRootDocument: TDomCustomDocument;
begin
  Result := OwnerDocument;
end;

function TDomNode.GetTextContent: WideString;
var
  ChildType: TDomNodeType;
  ChildItem: TDomNode;
  I, Cl: Integer;
  S: TUtilsCustomWideStr;
begin
  case NodeType of
    ntElement_Node, ntEntity_Reference_Node, ntDocument_Fragment_Node: begin
      S := TUtilsCustomWideStr.Create;
      try
        Cl := Pred(Childnodes.Length);
        for I := 0 to Cl do begin
          ChildItem := Childnodes.Item(I);
          ChildType := ChildItem.NodeType;
          if (ChildType <> ntComment_Node) and (ChildType <> ntProcessing_Instruction_Node) then
            S.AddWideString(ChildItem.TextContent);
        end;
        Result := S.Value;
      finally
        S.Free;
      end;
    end;
    ntAttribute_Node, ntText_Node, ntCDATA_Section_Node, ntComment_Node, ntProcessing_Instruction_Node:
      Result := NodeValue;
  else
    Result := '';
  end;
end;

function TDomNode.GetXPathStringValue: WideString;
begin
  case NodeType of
    ntElement_Node:
      Result := TextContent;
    ntAttribute_Node, ntComment_Node, ntProcessing_Instruction_Node, ntText_Node:
      Result := NodeValue;
    ntDocument_Node:
      if Assigned(TDomCustomDocument(Self).DocumentElement)
        then Result := TDomCustomDocument(Self).DocumentElement.TextContent
        else Result := '';
    ntXPath_Namespace_Node:
      Result := NamespaceUri;
  else
    Result := '';
  end;
end;

function TDomNode.HasAsAncestor(const Node: TDomNode): Boolean;
begin
  Result := inherited HasAsAncestor(Node);
end;

function TDomNode.HasAttributes: Boolean;
begin
  if Assigned(Attributes)
    then Result := Attributes.Length > 0
    else Result := False;
end;

function TDomNode.HasChildNodes: Boolean;
begin
  Result := HasChildren;
end;

function TDomNode.HasEntRef(const EntName: WideString): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Pred(Childnodes.Length) do
    with Childnodes.Item(I) do
      if (NodeType = ntEntity_Reference_Node)
          and (NodeName = EntName)
        then Result := True
        else if HasEntRef(EntName) then begin Result := True; Exit; end;
end;

function TDomNode.InsertBefore(const NewChild,
                                     RefChild: TDomNode): TDomNode;
begin
  CheckTypeAllowed(NewChild);

  if NewChild is TDomDocumentFragment then begin

    CheckAssigned(NewChild);
    CheckSameOwner(NewChild);
    CheckDissimilarity(NewChild, RefChild); 
    while NewChild.HasChildNodes do
      InsertBefore(NewChild.ChildNodes.Item(0), RefChild);
    Result := NewChild;

  end else
    Result := (inherited InsertBefore(NewChild, RefChild) as TDomNode);
end;

function TDomNode.LookupNamespaceURI(const APrefix: WideString): WideString;
begin
  if APrefix = 'xml'
    then Result := 'http://www.w3.org/XML/1998/namespace'
    else if APrefix = 'xmlns'
      then Result := 'http://www.w3.org/2000/xmlns/'
      else Result := '';
end;

procedure TDomNode.MakeChildrenReadOnly;
var
  I: Integer;
begin
  with Childnodes do
    for I := 0 to Pred(Length) do
      with Item(I) do begin
        SetReadOnly(True);
        MakeChildrenReadOnly;
      end;
end;

procedure TDomNode.Normalize;
var
  I: Integer;
begin
  with ChildNodes do
    for I := 0 to Pred(Length) do
      Item(I).Normalize;
end;

function TDomNode.PreviousNode: TDomNode;
// Finds the previous node in document order.
var
  NewNode: TDomNode;
begin
  Result := PreviousSibling;
  if Assigned(Result) then begin
    NewNode := Result;
    while Assigned(NewNode) do begin
      Result := NewNode;
      NewNode := NewNode.LastChild;
    end;
  end else Result := ParentNode;
end;

function TDomNode.RemoveChild(const OldChild: TDomNode): TDomNode;
begin
  Result := (inherited Remove(OldChild) as TDomNode);
end;

function TDomNode.ReplaceChild(const NewChild,
                                     OldChild: TDomNode): TDomNode;
var
  LastFragmentChild: TDomNode;
begin
  CheckTypeAllowed(NewChild);
  if NewChild is TDomDocumentFragment then begin

    CheckAssigned(NewChild);
    CheckSameOwner(NewChild);
    CheckHasChild(OldChild);

    LastFragmentChild := NewChild.LastChild;
    if Assigned(LastFragmentChild) then begin
      Result := ReplaceChild(LastFragmentChild, OldChild);
      while NewChild.HasChildNodes do
        InsertBefore(NewChild.ChildNodes.Item(0), LastFragmentChild);
    end else Result := RemoveChild(OldChild);

  end else Result := (inherited Replace(NewChild, OldChild) as TDomNode);
end;

procedure TDomNode.SetNodeValue(const Value: WideString);
begin
  if IsReadonly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  FNodeValue := Value;
end;

procedure TDomNode.SetPrefix(const Value: WideString);
begin
  if IsReadonly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
end;

function TDomNode.SetUserData(const Key: WideString;
                              const Data: TObject;
                              const Handler: TDomUserDataEvent): TObject;
var
  Index: Integer;
begin
  if Assigned(Data) then begin

    if Assigned(FUserData) then begin
      Index := FUserData.IndexOf(Key);
      if Index = -1 then begin
        Result := nil;
        FUserData.AddObject(Key, Data);
        FUserDataHandlers.Add(@Handler);
      end else begin
        Result := FUserData.Objects[Index];
        FUserData.WideStrings[Index] := Key;
        FUserData.Objects[Index] := Data;
        FUserDataHandlers[Index] := @Handler;
      end;
    end else begin
      FUserData := TUtilsWideStringList.Create;
      FUserDataHandlers := TList.Create;
      Result := nil;
      FUserData.AddObject(Key, Data);
      FUserDataHandlers.Add(@Handler);
    end;

  end else begin

    if Assigned(FUserData) then begin
      Index := FUserData.IndexOf(Key);
      if Index > -1 then begin
        Result := FUserData.Objects[Index];
        FUserData.Delete(Index);
        FUserDataHandlers.Delete(Index);
        if FUserData.Count = 0 then begin
          FUserData.Free;
          FUserData := nil;
          FUserDataHandlers.Free;
          FUserDataHandlers := nil;
        end;
      end else
        Result := nil;
    end else
      Result := nil;

  end;
end;

function TDomNode.Supports(const Feature,
                                 Version: WideString): Boolean;
var
  VersionStr: string;
begin
  Result := False;
  VersionStr := WideCharToString(PWideChar(Feature));
  if (WideCharToString(PWideChar(Version)) = '1.0')
    or (WideCharToString(PWideChar(Version)) = '')
  then begin
    if (CompareText(VersionStr, 'XML')=0)
       then Result := True;
  end else begin
    if (WideCharToString(PWideChar(Version)) = '2.0')
      then begin
        if (CompareText(VersionStr ,'XML')=0)
           then Result := True;
    end; {if ...}
  end; {if ... else ...}
end;



//+++++++++++++++++++++++++ TDomCharacterData ++++++++++++++++++++++++++++
constructor TDomCharacterData.Create(const AOwner: TDomCustomDocument);
begin
  inherited Create(AOwner);
  FAllowedChildTypes := [];
end;

procedure TDomCharacterData.AppendData(const Arg: WideString);
begin
  if IsReadonly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  Data := Concat(Data, Arg);
end;

procedure TDomCharacterData.deleteData(const Offset,
                                             Count: Integer);
begin
  ReplaceData(Offset, Count, '');
end;

procedure TDomCharacterData.DoCharacterDataModified;
begin
  if Assigned(RootDocument)
    then RootDocument.DoCharacterDataModified(Self);
end;

function TDomCharacterData.GetData: WideString;
begin
  Result := NodeValue;
end;

function TDomCharacterData.GetLength: Integer;
begin
  Result := System.Length(Data);
end;

procedure TDomCharacterData.InsertData(const Offset: Integer;
                                       const Arg: WideString);
begin
  ReplaceData(Offset, 0, Arg);
end;

procedure TDomCharacterData.ReplaceData(const Offset,
                                              Count: Integer;
                                        const Arg: WideString);
var
  Len: Integer;
  Data1, Data2: WideString;
begin
  if IsReadonly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  if (Offset < 0) or (Offset > Length) or (Count < 0) then
    raise EIndex_Size_Err.Create('Index size error.');
  // Make sure, that the length of the WideString is not
  // exeeded, when using Count and Offset:
  Len := Length - Offset;
  if Count < Len then Len := Count;
  Data1 := SubstringData(0, Offset);
  Data2 := SubstringData(Offset + Len, Length - Offset - Len);
  Data := Concat(Data1, Arg, Data2);
end;

procedure TDomCharacterData.SetData(const Value: WideString);
var
  PrevValue: WideString;
begin
  PrevValue := NodeValue;
  NodeValue := Value;
  DoCharacterDataModified;
end;

function TDomCharacterData.substringData(const Offset,
                                               Count: Integer): WideString;
var
  Len: Integer;
begin
  if (Offset < 0) or (Offset > Length) or (Count < 0) then
    raise EIndex_Size_Err.Create('Index size error.');
  // Make sure, that the length of the WideString is not
  // exeeded, when using Count and Offset:
  Len := Length - Offset;
  if Count < Len then Len := Count;
  SetString(Result, PWideChar(Data) + Offset, Len);
end;



// +++++++++++++++++++++++++++++++ TDomAttr +++++++++++++++++++++++++++++++
constructor TDomAttr.Create(const AOwner: TDomDocument;
                            const Name: WideString;
                            const Spcfd: Boolean);
begin
  if not IsXmlName(Name)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner);
  if IsXmlDefaultAttName(Name) then begin
    FIsXmlnsDecl:= NSDT_DEFAULT;
  end else if IsXmlPrefixedAttName(Name) then begin
    FIsXmlnsDecl:= NSDT_PREFIXED;
  end else FIsXmlnsDecl:= NSDT_NONE;
  FNodeName := Name;
  FNodeValue := '';
  FPrefix := '';
  FSpecified := Spcfd;
  FAllowedChildTypes := [];
end;

constructor TDomAttr.CreateNS(const AOwner: TDomDocumentNS;
                              const NamespaceURI,
                                    QualifiedName: WideString;
                              const Spcfd: Boolean);
var
  LocName, Prfx: WideString;
begin
  if not XmlExtractPrefixAndLocalName(QualifiedName, Prfx, LocName) then begin
    if not IsXmlName(QualifiedName)
      then raise EInvalid_Character_Err.Create('Invalid character error.')
      else raise ENamespace_Err.Create('Namespace error.');
  end;
  if Prfx = 'xmlns' then begin
    if not (NamespaceURI ='http://www.w3.org/2000/xmlns/')
      then raise ENamespace_Err.Create('Namespace error.');
    FIsXmlnsDecl := NSDT_PREFIXED;
  end else if QualifiedName = 'xmlns' then begin
    if not (NamespaceURI ='http://www.w3.org/2000/xmlns/')
      then raise ENamespace_Err.Create('Namespace error.');
    FIsXmlnsDecl := NSDT_DEFAULT;
  end else FIsXmlnsDecl := NSDT_NONE;
  if (NamespaceURI = '') and (Prfx <> '')
    then raise ENamespace_Err.Create('Namespace error.');
  if (Prfx = 'xml') and (NamespaceURI <> 'http://www.w3.org/XML/1998/namespace')
    then raise ENamespace_Err.Create('Namespace error.');
  inherited Create(AOwner);
  FNodeName := QualifiedName;
  FNamespaceURI := NamespaceURI;
  FPrefix := Prfx;
  FLocalName := LocName;
  FIsNamespaceNode := True;
  FNodeValue := '';
  FSpecified := Spcfd;
  FAllowedChildTypes := [];
end;

destructor TDomAttr.Destroy;
var
  OldReadOnly: Boolean;
begin
  if Assigned(OwnerElement) then begin
    with OwnerElement do begin
      OldReadOnly := IsReadOnly;
      SetReadOnly(False);
      try
        RemoveAttributeNode(Self)
      finally
        SetReadOnly(OldReadonly);
      end;
    end;
  end;
  inherited;
end;

procedure TDomAttr.DoAttrModified(const AttrChange: TDomAttrChange);
begin
  if Assigned(OwnerElement)
    then OwnerElement.DoAttrModified(OwnerElement, AttrChange, Self);
end;

function TDomAttr.GetDataType: TXmlDataType;
begin
  if Assigned(RootDocument) and Assigned(OwnerElement) then
    Result := RootDocument.GetAttrDataType(OwnerElement.NodeName, NodeName)
  else
    Result := AS_STRING_DATATYPE;
end;

function TDomAttr.GetExpandedName: WideString;
begin
  Result := NodeName;
end;

function TDomAttr.GetIsXmlnsDecl: TDomXmlnsDeclType;
begin
  Result := FIsXmlnsDecl;
end;

function TDomAttr.GetLocalName: WideString;
begin
  Result := FLocalName;
end;

function TDomAttr.GetName: WideString;
begin
  Result := NodeName;
end;

function TDomAttr.GetNamespaceURI: WideString;
begin
  Result := FNamespaceURI;
end;

function TDomAttr.GetNextSibling: TDomNode;
begin
  Result := nil;
end;

function TDomAttr.GetNodeName: WideString;
begin
  Result := FNodeName;
end;

function TDomAttr.GetNodeType: TDomNodeType;
begin
  Result := ntAttribute_Node;
end;

function TDomAttr.GetOwnerElement: TDomElement;
var
  Node: TDomNode;
begin
  if Assigned(FOwnerMap) then begin
    Node := FOwnerMap.OwnerNode;
    if Node.NodeType = ntElement_Node
      then Result := (Node as TDomElement)
      else Result := nil;
  end else Result := nil;
end;

function TDomAttr.GetPrefix: WideString;
begin
  Result := FPrefix;
end;

function TDomAttr.GetPreviousSibling: TDomNode;
begin
  Result := nil;
end;

function TDomAttr.GetSpecified: Boolean;
begin
  Result := FSpecified;
end;

function TDomAttr.GetValue: WideString;
var
  Error: TXmlErrorType;
begin
  RootDocument.CalculateNormalizedAttrValue(NodeValue, DataType, Result, Error);
  if not (Error in ET_WARNINGS) then
    raise EConvertError.Create('Attribute value normalization failed.');
end;

function TDomAttr.LookupNamespaceURI(const APrefix: WideString): WideString;
begin
  if APrefix = '' then begin
    Result := '';
  end else begin
    if Assigned(OwnerElement)
      then Result := OwnerElement.LookupNamespaceURI(APrefix)
      else Result := inherited LookupNamespaceURI(APrefix);
  end;
end;

procedure TDomAttr.SetNodeValue(const Value: WideString);
begin
  inherited;
   DoAttrModified(AC_MODIFICATION);
end;

procedure TDomAttr.SetPrefix(const Value: WideString);
begin
  if not IsXmlName(Value)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  if IsReadonly
    then raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  if not IsXmlPrefix(Value)
    then raise ENamespace_Err.Create('Namespace error.');
  if NamespaceURI = ''
    then raise ENamespace_Err.Create('Namespace error.');
  if (Value = 'xml') and (NamespaceURI <> 'http://www.w3.org/XML/1998/namespace')
    then raise ENamespace_Err.Create('Namespace error.');
  if (Value = 'xmlns')
    and not (NamespaceURI ='http://www.w3.org/2000/xmlns/')
      then raise ENamespace_Err.Create('Namespace error.');
  if NodeName = 'xmlns'
    then raise ENamespace_Err.Create('Namespace error.');
  FPrefix := Value;
  FNodeName := Concat(Value, ':', LocalName);
end;



//++++++++++++++++++++++++++++ TDomElement ++++++++++++++++++++++++++++++++
constructor TDomElement.Create(const AOwner: TDomDocument;
                               const TagName: WideString);
begin
  if not IsXmlName(TagName) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner);
  FNodeName := TagName;
  FNodeValue := '';
  FPrefix := '';
  FAttributeListing := TList.Create;
  FCreatedElementsNodeLists := TList.Create;
  FCreatedElementsNodeListNSs := TList.Create;
  FAttributeList := TDomNamedNodeMap.Create(Self, FAttributeListing, [ntAttribute_Node], False);
  FAllowedChildTypes := [ ntElement_Node,
                          ntText_Node,
                          ntCDATA_Section_Node,
                          ntEntity_Reference_Node,
                          ntProcessing_Instruction_Node,
                          ntComment_Node,
                          ntDocument_Fragment_Node ];
end;

constructor TDomElement.CreateNS(const AOwner: TDomDocumentNS;
                                 const NamespaceURI,
                                       QualifiedName: WideString);
var
  locName,prfx: WideString;
begin
  if not XmlExtractPrefixAndLocalName(QualifiedName, Prfx, LocName) then begin
    if not IsXmlName(QualifiedName)
      then raise EInvalid_Character_Err.Create('Invalid character error.')
      else raise ENamespace_Err.Create('Namespace error.');
  end;
  if (NamespaceURI = '') and (Prfx <> '')
    then raise ENamespace_Err.Create('Namespace error.');
  if (Prfx = 'xml') and (NamespaceURI <> 'http://www.w3.org/XML/1998/namespace')
    then raise ENamespace_Err.Create('Namespace error.');
  inherited Create(AOwner);
  FNodeName:= QualifiedName;
  FNamespaceURI:= NamespaceURI;
  FPrefix := Prfx;
  FLocalName := LocName;
  FIsNamespaceNode:= True;
  FNodeValue := '';
  FAttributeListing:= TList.Create;
  FCreatedElementsNodeLists:= TList.Create;
  FCreatedElementsNodeListNSs:= TList.Create;
  FAttributeList:= TDomNamedNodeMap.Create(Self,FAttributeListing,[ntAttribute_Node],True);
  FAllowedChildTypes:= [ntElement_Node,
                        ntText_Node,
                        ntCDATA_Section_Node,
                        ntEntity_Reference_Node,
                        ntProcessing_Instruction_Node,
                        ntComment_Node,
                        ntDocument_Fragment_Node];
end;

destructor TDomElement.Destroy;
var
  I: Integer;
begin
  ReadOnly := False;
  DoBeforeClear; // Removes all attached attribute nodes.
  FAttributeList.Free;
  FAttributeList := nil;
  FAttributeListing.Free;
  if Assigned(FCreatedElementsNodeLists) then
    for I := 0 to Pred(FCreatedElementsNodeLists.Count) do
      TDomElementsNodeList(FCreatedElementsNodeLists[I]).Free;
  if Assigned(FCreatedElementsNodeListNSs) then
    for I := 0 to Pred(FCreatedElementsNodeListNSs.Count) do
      TDomElementsNodeListNS(FCreatedElementsNodeListNSs[I]).Free;
  FCreatedElementsNodeLists.Free;
  FCreatedElementsNodeListNSs.Free;
  inherited Destroy;
end;

procedure TDomElement.DoAttrModified(const originalTarget: TDomNode;
                                     const AttrChange: TDomAttrChange;
                                     const RelatedAttr: TDomAttr);
begin
  if Assigned(RootDocument)
    then RootDocument.DoAttrModified(OriginalTarget, AttrChange, RelatedAttr);
end;

procedure TDomElement.DoBeforeClear;
var
  OldAttr: TDomAttr;
begin
  while HasAttributes do begin
    OldAttr := RemoveAttributeNode(Attributes.Item(0) as TDomAttr);
    OldAttr.Free;
  end;
end;

function TDomElement.GetTagName: WideString;
begin
  Result := NodeName;
end;

function TDomElement.GetAttributes: TDomNamedNodeMap;
begin
  Result := FAttributeList;
end;

function TDomElement.GetAttributeLiteralValue(const Name: WideString): WideString;
var
  Attr: TDomAttr;
begin
  Attr := GetAttributeNode(Name);
    // Raises ENamespace_Err, if attributes.namespaceAware is 'True'.
  if Assigned(Attr)
    then Result := Attr.NodeValue
    else Result := '';
end;

function TDomElement.GetAttributeNode(const Name: WideString): TDomAttr;
begin
  Result := TDomAttr(Attributes.GetNamedItem(Name));
    // Raises ENamespace_Err, if attributes.namespaceAware is 'True'.
end;

function TDomElement.GetAttributeNodeNS(const NamespaceURI,
                                              LocalName: WideString): TDomAttr;
begin
  Result := TDomAttr(Attributes.GetNamedItemNS(NamespaceURI, LocalName));
    // Raises ENamespace_Err, if attributes.namespaceAware is 'False'.
end;

function TDomElement.GetAttributeNormalizedValue(const Name: WideString): WideString;
var
  Attr: TDomAttr;
begin
  Attr := GetAttributeNode(Name);  // Raises ENamespace_Err, if attributes.namespaceAware is 'True'.
  if Assigned(Attr) then begin
    try
      Result := Attr.Value;
    except
      raise EConvertError.Create('Literal attribute value cannot be resolved.');
    end;
  end else Result := '';
end;

function TDomElement.GetAttributeNSLiteralValue(const NamespaceURI,
                                                      LocalName: WideString): WideString;
var
  Attr: TDomAttr;
begin
  Attr := GetAttributeNodeNS(NamespaceURI, LocalName); // Raises ENamespace_Err, if attributes.namespaceAware is 'False'.
  if Assigned(Attr)
    then Result := Attr.NodeValue
    else Result := '';
end;

function TDomElement.GetAttributeNSNormalizedValue(const NamespaceURI,
                                                         LocalName: WideString): WideString;
var
  Attr: TDomAttr;
begin
  Attr := GetAttributeNodeNS(NamespaceURI, LocalName); // Raises ENamespace_Err, if attributes.namespaceAware is 'False'.
  if Assigned(Attr) then begin
    try
      Result := Attr.Value;
    except
      raise EConvertError.Create('Literal attribute value cannot be resolved.');
    end;
  end else Result := '';
end;

function TDomElement.GetElementsByTagName(const Name: WideString): TDomNodeList;
var
  I: Integer;
begin
  for I := 0 to Pred(FCreatedElementsNodeLists.Count) do
    if TDomElementsNodeList(FCreatedElementsNodeLists[I]).FQueryName = Name
      then begin Result := TDomElementsNodeList(FCreatedElementsNodeLists[I]); Exit; end;
  Result := TDomElementsNodeList.Create(Name, Self);
  FCreatedElementsNodeLists.Add(Result);
end;

function TDomElement.GetElementsByTagNameNS(const NamespaceURI,
                                                  LocalName: WideString): TDomNodeList;
var
  I: Integer;
  NL: TDomElementsNodeListNS;
begin
  for I := 0 to Pred(FCreatedElementsNodeListNSs.Count) do begin
    NL := TDomElementsNodeListNS(FCreatedElementsNodeListNSs[I]);
    if (NL.FQueryNamespaceURI = NamespaceURI) and (NL.FQueryLocalName = LocalName)
      then begin Result := NL; Exit; end;
  end;
  Result := TDomElementsNodeListNS.Create(NamespaceURI, LocalName, Self);
  FCreatedElementsNodeListNSs.Add(Result);
end;

function TDomElement.GetExpandedName: WideString;
begin
  Result := NodeName;
end;

function TDomElement.GetLocalName: WideString;
begin
  Result := FLocalName;
end;

function TDomElement.GetNamespaceURI: WideString;
begin
  Result := FNamespaceURI;
end;

function TDomElement.GetNodeName: WideString;
begin
  Result := FNodeName;
end;

function TDomElement.GetNodeType: TDomNodeType;
begin
  Result := ntElement_Node;
end;

function TDomElement.GetPrefix: WideString;
begin
  Result := FPrefix;
end;

function TDomElement.HasAttribute(const Name: WideString): Boolean;
begin
  Result := Assigned(Attributes.GetNamedItem(Name));
end;

function TDomElement.HasAttributeNS(const NamespaceURI,
                                          LocalName: WideString): Boolean;
begin
  Result := Assigned(Attributes.GetNamedItemNS(NamespaceURI, LocalName));
end;

function TDomElement.LookupNamespaceURI(const APrefix: WideString): WideString;
var
  I: Integer;
begin
  if APrefix = '' then begin
    with Attributes do
      for I := 0 to Pred(Length) do
        with TDomAttr(Item(I)) do
          if IsXmlnsDecl = NSDT_DEFAULT then begin
            Result := NodeValue;
            Exit;
          end;
  end else begin
    with Attributes do
      for I := 0 to Pred(Length) do
        with TDomAttr(Item(I)) do
          if (IsXmlnsDecl = NSDT_PREFIXED) and (LocalName = APrefix) then begin
            Result := NodeValue;
            Exit;
          end;
  end;
  if Assigned(ParentNode)
    then Result := ParentNode.LookupNamespaceURI(APrefix)
    else Result := inherited LookupNamespaceURI(APrefix);
end;

procedure TDomElement.Normalize;
var
  PrevNode, CurrentNode: TDomNode;
  I: Integer;
begin
  {Normalize text:}
  PrevNode := nil;
  I := ChildNodes.Length;
  while I > 0 do
  begin
    Dec(I);
    CurrentNode := ChildNodes.Item(I);
    if (CurrentNode.NodeType = ntText_Node) then
      begin
         if (Assigned(PrevNode)) and (PrevNode.NodeType = ntText_Node) then begin
            (CurrentNode as TDomText).AppendData((PrevNode as TDomText).Data);
            if (PrevNode as TDomText).CharRefGenerated then
              (CurrentNode as TDomText).CharRefGenerated := True;
            PrevNode.Free;  // Removes and frees the node.
         end;
      end
    else  // no text node, then normalize
      CurrentNode.Normalize;
    PrevNode:=CurrentNode;
  end;

  {Normalize attributes:}
  for I := 0 to Attributes.Length - 1 do
    Attributes.Item(I).Normalize;
end;

function TDomElement.RemoveAttribute(const Name: WideString): TDomAttr;
begin
  Result := RemoveAttributeNode(GetAttributeNode(Name));
     // GetAttributeNode() raises an ENamespace_Err if attributes.namespaceAware is 'True'.
     // RemoveAttributeNode() raises an ENo_Modification_Allowed_Err if readonly, ...
     // ... and an ENot_Found_Err if the node was not found.
end;

function TDomElement.RemoveAttributeNode(const OldAttr: TDomAttr): TDomAttr;
begin
  Result := Attributes.RemoveItem(OldAttr) as TDomAttr;
     // Raises an ENo_Modification_Allowed_Err if readonly, ...
     // ... and an ENot_Found_Err if the node was not found.

  DoAttrModified(Self, AC_REMOVAL, OldAttr);
end;

function TDomElement.RemoveAttributeNS(const NamespaceURI,
                                             LocalName: WideString): TDomAttr;
begin
  Result := RemoveAttributeNode(GetAttributeNodeNS(NamespaceURI, LocalName));
     // GetAttributeNodeNS() raises ENamespace_Err if attributes.namespaceAware is 'False'.
     // RemoveAttributeNode() raises an ENo_Modification_Allowed_Err if readonly, ...
     // ... and an ENot_Found_Err if the node was not found.
end;

function TDomElement.SetAttribute(const Name,
                                        Value: WideString): TDomAttr;
var
  Attr: TDomAttr;
begin
  if IsReadonly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  Attr := GetAttributeNode(Name);
    // Raises ENamespace_Err, if attributes.namespaceAware is 'True'.
  if Assigned(Attr) then begin
    Attr.NodeValue := Value;
    Result := nil;
  end else begin
    Result := TDomAttr.Create(RootDocument as TDomDocument, Name, True);
    Result.NodeValue := Value; // Important: Set the nodeValue before adding the attribute to avoid double OnAttrModified event call.
    Attributes.InternalAdd(Result);
    DoAttrModified(Self, AC_ADDITION, Result);
  end;
end;

function TDomElement.SetAttributeNS(const NamespaceURI,
                                          QualifiedName,
                                          Value: WideString): TDomAttr;
var
  Attr: TDomAttr;
  Prfx, Localname: WideString;
begin
  if IsReadonly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  if not XmlExtractPrefixAndLocalName(QualifiedName, Prfx, LocalName) then begin
    if not IsXmlName(QualifiedName)
      then raise EInvalid_Character_Err.Create('Invalid character error.')
      else raise ENamespace_Err.Create('Namespace error.');
  end;
  if ( ((Prfx = 'xmlns') or (QualifiedName = 'xmlns'))
    and not (NamespaceURI ='http://www.w3.org/2000/xmlns/') ) then
      raise ENamespace_Err.Create('Namespace error.');
  if (NamespaceURI = '') and (Prfx <> '') then
    raise ENamespace_Err.Create('Namespace error.');
  if (Prfx = 'xml') and (NamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then
    raise ENamespace_Err.Create('Namespace error.');
  Attr := GetAttributeNodeNS(NamespaceURI, LocalName);
    // Raises ENamespace_Err, if attributes.namespaceAware is 'False'.
  if Assigned(Attr) then begin
    Attr.SetPrefix(Prfx);
    Attr.NodeValue := Value;
    Result := nil;
  end else begin
    Result := TDomAttr.CreateNS(RootDocument as TDomDocumentNS, NamespaceURI, QualifiedName, True);
    Result.NodeValue := Value; // Important: Set the nodeValue before adding the attribute to avoid double OnAttrModified event call.
    Attributes.InternalAdd(Result);
    DoAttrModified(Self, AC_ADDITION, Result);
  end;
end;

function TDomElement.SetAttributeNode(const NewAttr: TDomAttr): TDomAttr;
var
  AttrModified: Boolean;
begin
  AttrModified := NewAttr.OwnerElement = nil;
  Result := (Attributes.SetNamedItem(NewAttr) as TDomAttr); // Raises all required exceptions.
  if AttrModified then
    DoAttrModified(Self, AC_ADDITION, NewAttr);
end;

function TDomElement.SetAttributeNodeNS(const NewAttr: TDomAttr): TDomAttr;
var
  AttrModified: Boolean;
begin
  AttrModified := NewAttr.OwnerElement = nil;
  Result := (Attributes.SetNamedItemNS(NewAttr) as TDomAttr); // Raises all required exceptions.
  if AttrModified then
    DoAttrModified(Self, AC_ADDITION, NewAttr);
end;

procedure TDomElement.SetNodeValue(const Value: WideString);
begin
  // Do nothing.
end;

procedure TDomElement.SetPrefix(const Value: WideString);
begin
  if not IsXmlName(Value) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  if IsReadonly then
    raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  if not IsXmlPrefix(Value) then
    raise ENamespace_Err.Create('Namespace error.');
  if NamespaceURI = '' then
    raise ENamespace_Err.Create('Namespace error.');
  if (Value = 'xml') and (NamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then
    raise ENamespace_Err.Create('Namespace error.');
  FPrefix := Value;
  FNodeName := Concat(Value, ':', LocalName);
end;



//+++++++++++++++++++++++++++++ TDomText +++++++++++++++++++++++++++++++++
constructor TDomText.Create(const AOwner: TDomCustomDocument);
begin
  inherited;
  FNodeValue := '';
  FCharRefGenerated := False;
  FAllowedChildTypes:= [];
end;

function TDomText.GetIsElementContentWhitespace: Boolean;
begin
  if RootDocument is TDomDocument
    then Result := (RootDocument as TDomDocument).GetIsElementContentWhitespace(Self)
    else Result := False;
end;

function TDomText.GetNodeName: WideString;
begin
  Result := '#text';
end;

function TDomText.GetNodeType: TDomNodeType;
begin
  Result := ntText_Node;
end;

function TDomText.SplitText(const Offset: Integer): TDomText;
begin
  if IsReadonly
    then raise ENo_Modification_Allowed_Err.Create('No modification allowed error.');
  if(Offset < 0) or (Offset > Length)
    then raise EIndex_Size_Err.Create('Index size error.');
  Result := TDomText.Create(RootDocument);
  Result.Data := SubstringData(Offset, Length - Offset);
  Result.CharRefGenerated := CharRefGenerated;
  DeleteData(Offset, Length - Offset);
  if Assigned(ParentNode) then
    ParentNode.InsertBefore(Result, Self.NextSibling);
end;



//++++++++++++++++++++++++++++ TDomComment +++++++++++++++++++++++++++++++
constructor TDomComment.Create(const AOwner: TDomCustomDocument);
begin
  inherited Create(AOwner);
  FNodeValue := '';
  FAllowedChildTypes := [];
end;

function TDomComment.GetNodeName: WideString;
begin
  Result := '#comment';
end;

function TDomComment.GetNodeType: TDomNodeType;
begin
  Result := ntComment_Node;
end;



//+++++++++++++++++++++ TDomProcessingInstruction +++++++++++++++++++++++++
constructor TDomProcessingInstruction.Create(const AOwner: TDomCustomDocument;
                                             const Targ: WideString);
begin
  if not IsXmlPITarget(Targ) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner);
  FTarget := Targ;
  FNodeValue := '';
  FAllowedChildTypes := [];
end;

procedure TDomProcessingInstruction.DoCharacterDataModified;
begin
  if Assigned(RootDocument) then
    RootDocument.DoCharacterDataModified(Self);
end;

function TDomProcessingInstruction.GetData: WideString;
begin
  Result := FNodeValue;
end;

function TDomProcessingInstruction.GetExpandedName: WideString;
begin
  Result := Target;
end;

function TDomProcessingInstruction.GetNodeName: WideString;
begin
  Result := Target;
end;

function TDomProcessingInstruction.GetNodeType: TDomNodeType;
begin
  Result := ntProcessing_Instruction_Node;
end;

procedure TDomProcessingInstruction.SetData(const Value: WideString);
var
  PrevValue: WideString;
begin
  PrevValue := NodeValue;
  NodeValue := Value;
  DoCharacterDataModified;
end;



//++++++++++++++++++++++++++ TDomCDATASection +++++++++++++++++++++++++++++
constructor TDomCDATASection.Create(const AOwner: TDomCustomDocument);
begin
  inherited Create(AOwner);
  FNodeValue := '';
end;

function TDomCDATASection.GetNodeName: WideString;
begin
  Result := '#cdata-section';
end;

function TDomCDATASection.GetNodeType: TDomNodeType;
begin
  Result := ntCDATA_Section_Node;
end;



//++++++++++++++++++++++++ TDomDocumentTypeDecl +++++++++++++++++++++++++++
constructor TDomDocumentTypeDecl.Create(const AOwner: TDomCustomDocument;
                                        const DoctypeName,
                                              PubId,
                                              SysId,
                                              IntSubset: WideString);
begin
  inherited Create(AOwner);
  FNodeName := DoctypeName;
  FNodeValue := '';
  FPublicId := PubId;
  FSystemId := SysId;
  FInternalSubset := IntSubset;
  FIntSubsetByteNumber := 0;
  FIntSubsetCharNumber := 0;
  FIntSubsetStartColumn := 0;
  FIntSubsetStartLine := 1;
  FAllowedChildTypes := [];
end;

function TDomDocumentTypeDecl.GetInternalSubset: WideString;
begin
  Result := FInternalSubset;
end;

function TDomDocumentTypeDecl.GetName: WideString;
begin
  Result := NodeName;
end;

function TDomDocumentTypeDecl.GetNodeName: WideString;
begin
  Result := FNodeName;
end;

function TDomDocumentTypeDecl.GetNodeType: TDomNodeType;
begin
  Result := ntDocument_Type_Decl_Node;
end;

function TDomDocumentTypeDecl.GetPublicId: WideString;
begin
  Result := FPublicId;
end;

function TDomDocumentTypeDecl.GetSystemId: WideString;
begin
  Result := FSystemId;
end;

procedure TDomDocumentTypeDecl.SetNodeValue(const Value: WideString);
begin
  // Do nothing.
end;



//++++++++++++++++++++++++ TDomEntityReference +++++++++++++++++++++++++
constructor TDomEntityReference.Create(const AOwner: TDomCustomDocument;
                                       const Name: WideString);
begin
  if not IsXmlName(Name)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner);
  SetReadOnly(True);
  FNodeName := Name;
  FNodeValue := '';
  FAllowedChildTypes := [ ntElement_Node,
                          ntText_Node,
                          ntCDATA_Section_Node,
                          ntEntity_Reference_Node,
                          ntProcessing_Instruction_Node,
                          ntComment_Node,
                          ntDocument_Fragment_Node ];
end;

function TDomEntityReference.GetNodeName: WideString;
begin
  Result := FNodeName;
end;

function TDomEntityReference.GetNodeType: TDomNodeType;
begin
  Result := ntEntity_Reference_Node;
end;

procedure TDomEntityReference.SetNodeValue(const Value: WideString);
begin
  // Do nothing.
end;



//++++++++++++++++++++++++ TDomDocumentFragment +++++++++++++++++++++++++++
constructor TDomDocumentFragment.Create(const AOwner: TDomCustomDocument);
begin
  inherited Create(AOwner);
  FNodeValue := '';
  FAllowedChildTypes:= [ntElement_Node,
                        ntText_Node,
                        ntCDATA_Section_Node,
                        ntEntity_Reference_Node,
                        ntProcessing_Instruction_Node,
                        ntComment_Node,
                        ntDocument_Fragment_Node];
end;

function TDomDocumentFragment.GetAbsoluteIndex: Integer;
begin
  Result := -1;
end;

function TDomDocumentFragment.GetLevel: Integer;
begin
  Result := -1;
end;

function TDomDocumentFragment.GetNodeName: WideString;
begin
  Result := '#document-fragment';
end;

function TDomDocumentFragment.GetNodeType: TDomNodeType;
begin
  Result := ntDocument_Fragment_Node;
end;

procedure TDomDocumentFragment.SetNodeValue(const Value: WideString);
begin
  // Do nothing.
end;



//+++++++++++++++++++++++++ TDomXPathNamespace ++++++++++++++++++++++++++++
constructor TDomXPathNamespace.Create(const AOwnerSet: TDomXPathNodeSetResult;
                                      const AOwnerElement: TDomElement;
                                      const ANamespaceUri,
                                            APrefix: WideString);
begin
  if not ( IsXmlPrefix(APrefix) or (APrefix = '') )
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  if ( (APrefix = 'xmlns') and not (ANamespaceUri = 'http://www.w3.org/2000/xmlns/') )
    then raise ENamespace_Err.Create('Namespace error.');
  if (ANamespaceUri = '') and (APrefix <> '')
    then raise ENamespace_Err.Create('Namespace error.');
  if (APrefix = 'xml') and (ANamespaceUri <> 'http://www.w3.org/XML/1998/namespace')
    then raise ENamespace_Err.Create('Namespace error.');
  inherited Create(AOwnerSet);
  FAllowedChildTypes := [];
  SetReadOnly(True);
  FNamespaceURI := ANamespaceUri;
  FOwnerElement := AOwnerElement;
  FPrefix := APrefix;
end;

function TDomXPathNamespace.GetDocument: TDomCustomDocument;
begin
  if Assigned(FOwnerElement)
    then Result := FOwnerElement.OwnerDocument
    else Result := nil;
end;

function TDomXPathNamespace.GetExpandedName: WideString;
begin
  Result := FPrefix;
end;

function TDomXPathNamespace.GetLocalName: WideString;
begin
  Result := FPrefix;
end;

function TDomXPathNamespace.GetNamespaceURI: WideString;
begin
  Result := FNamespaceURI;
end;

function TDomXPathNamespace.GetNodeName: WideString;
begin
  Result := '#namespace';
end;

function TDomXPathNamespace.GetNodeType: TDomNodeType;
begin
  Result := ntXPath_Namespace_Node;
end;

function TDomXPathNamespace.GetNodeValue: WideString;
begin
  Result := FNamespaceURI;
end;

function TDomXPathNamespace.GetOwnerElement: TDomElement;
begin
  Result := FOwnerElement;
end;

function TDomXPathNamespace.GetOwnerSet: TDomXPathNodeSetResult;
begin
  Result := (GetOwner as TDomXPathNodeSetResult);
end;

function TDomXPathNamespace.GetPrefix: WideString;
begin
  Result := FPrefix;
end;

function TDomXPathNamespace.LookupNamespaceURI(const APrefix: WideString): WideString;
begin
  if Assigned(OwnerElement)
    then Result := OwnerElement.LookupNamespaceURI(APrefix)
    else Result := inherited LookupNamespaceURI(APrefix);
end;



//+++++++++++++++++++++++++++ TDomCustomDocument ++++++++++++++++++++++++++++
constructor TDomCustomDocument.Create(const AOwner: TDomImplementation);
begin
  inherited Create(nil);
  FDomImpl := AOwner;
  if Assigned(FDomImpl) then
    FDomImpl.Attach(Self);


  FNodeValue := '';
  FSystemId:= '';
  FXmlEncoding:= '';
  FXmlStandalone:= STANDALONE_UNSPECIFIED;
  FXmlVersion:= '';
  FModified:= False;
  FDefaultView:= nil;
  FCreatedNodeIterators:= TList.Create;
  FCreatedTreeWalkers:= TList.Create;
  FAllowedChildTypes:= [ntElement_Node,
                        ntProcessing_Instruction_Node,
                        ntComment_Node,
                        ntDocument_Type_Decl_Node,
                        ntDocument_Fragment_Node];
end;

destructor TDomCustomDocument.Destroy;
var
  I : Integer;
begin
  // Free all NodeIterators:
  for I := 0 to Pred(FCreatedNodeIterators.Count) do
    TDomNodeIterator(FCreatedNodeIterators[I]).Free;
  FCreatedNodeIterators.Free;

  // Free all TreeWalkers:
  for I := 0 to Pred(FCreatedTreeWalkers.Count) do
    TDomTreeWalker(FCreatedTreeWalkers[I]).Free;
  FCreatedTreeWalkers.Free;

  if Assigned(FDomImpl) then
    FDomImpl.Detach(Self);
  inherited Destroy;
end;

function TDomCustomDocument.AppendChild(const NewChild: TDomNode): TDomNode;
begin
  if not Assigned(NewChild) then
    raise ENot_Supported_Err.Create('Not supported error.');
  case NewChild.NodeType of
    ntElement_Node:
      if Assigned(DocumentElement) then
        raise EHierarchy_Request_Err.Create('Hierarchy request error.');
    ntDocument_Type_Decl_Node:
      if Assigned(DocumentElement) or Assigned(DoctypeDecl) then
        raise EHierarchy_Request_Err.Create('Hierarchy request error.');
  end;
  Result := inherited AppendChild(NewChild);
end;

procedure TDomCustomDocument.ClearInvalidNodeIterators;
var
  I : Integer;
begin
  for I := 0 to Pred(FCreatedNodeIterators.Count) do
  if TDomNodeIterator(FCreatedNodeIterators[I]).FInvalid then begin
    TDomNodeIterator(FCreatedNodeIterators[I]).Free;
    FCreatedNodeIterators[I] := nil;
  end;
  FCreatedNodeIterators.Pack;
  FCreatedNodeIterators.Capacity:= FCreatedNodeIterators.Count;
end;

procedure TDomCustomDocument.DoAttrModified(const SourceNode: TDomNode;
                                            const AttrChange: TDomAttrChange;
                                            const RelatedAttr: TDomAttr);
begin
  FModified := True;
  try
    if Assigned(FOnAttrModified) then
      FOnAttrModified(Self, SourceNode, AttrChange, RelatedAttr);
  finally
    if Assigned(DomImplementation) then
      DomImplementation.DoAttrModified(SourceNode, AttrChange, RelatedAttr);
  end;
end;

procedure TDomCustomDocument.DoBeforeClear;
var
  I : Integer;
begin
  for I := 0 to Pred(FCreatedNodeIterators.Count) do
    TDomNodeIterator(FCreatedNodeIterators[I]).Free;
  FCreatedNodeIterators.Clear;
  for I := 0 to Pred(FCreatedTreeWalkers.Count) do
    TDomTreeWalker(FCreatedTreeWalkers[I]).Free;
  FCreatedTreeWalkers.Clear;
end;

procedure TDomCustomDocument.DoCharacterDataModified(Node: TDomNode);
begin
  FModified := True;
  try
    if Assigned(FOnCharacterDataModified) then
      FOnCharacterDataModified(Self, Node);
  finally
    if Assigned(DomImplementation) then
      DomImplementation.DoCharacterDataModified(Node);
  end;
end;

procedure TDomCustomDocument.DoNodeClearing(Node: TDomNode);
begin
  FModified := True;
  try
    if Assigned(FOnNodeClearing) then
      FOnNodeClearing(Self, Node);
  finally
    if Assigned(DomImplementation) then
      DomImplementation.DoNodeClearing(Node);
    NotifyIterators(Node, neClearing);
  end;
end;

procedure TDomCustomDocument.DoNodeInserted(Node: TDomNode);
begin
  FModified := True;
  try
    if Assigned(FOnNodeInserted) then
      FOnNodeInserted(Self, Node);
  finally
    if Assigned(DomImplementation) then
      DomImplementation.DoNodeInserted(Node);
  end;
end;

procedure TDomCustomDocument.DoNodeRemoving(Node: TDomNode);
begin
  FModified := True;
  try
    if Assigned(FOnNodeRemoving) then
      FOnNodeRemoving(Self, Node);
  finally
    if Assigned(DomImplementation) then
      DomImplementation.DoNodeRemoving(Node);
    NotifyIterators(Node, neRemoving);
  end;
end;

function TDomCustomDocument.GetAbsoluteIndex: Integer;
begin
  Result := 0;
end;

function TDomCustomDocument.GetAttrDataType(const ElementName,
                                                  AttrName: WideString): TXmlDataType;
begin
  Result := AS_STRING_DATATYPE;
end;

function TDomCustomDocument.GetLevel: Integer;
begin
  Result := 0;
end;

function TDomCustomDocument.GetNodeName: WideString;
begin
  Result := '#document';
end;

function TDomCustomDocument.GetNodeType: TDomNodeType;
begin
  Result := ntDocument_Node;
end;

function TDomCustomDocument.GetRootDocument: TDomCustomDocument;
begin
  Result := Self;
end;

function TDomCustomDocument.ImportNode(const ImportedNode: TDomNode;
                                       const Deep: Boolean): TDomNode;
var
  I: Integer;
  UserDataEvent: TDomUserDataEvent;
begin
  Result := ImportNode2(ImportedNode, Deep);

  // Call user data event handlers:
  with ImportedNode do
    if Assigned(Result) and Assigned(FUserData) then
      with FUserData do
        for I := 0 to Pred(Count) do begin
          @UserDataEvent := Pointer(FUserDataHandlers[I]);
          if Assigned(UserDataEvent) then
            UserDataEvent(OT_NODE_IMPORTED, WideStrings[I], Objects[I], ImportedNode, Result);
        end;
end;

function TDomCustomDocument.ImportNode2(const ImportedNode: TDomNode;
                                        const Deep: Boolean): TDomNode;
var
  I: Integer;
  NewChild: TDomNode;
  OldAttr: TDomAttr;
begin
  if not Assigned(ImportedNode) then
    raise ENot_Supported_Err.Create('Not supported error.');
  case ImportedNode.NodeType of
    ntAttribute_Node:
      with ImportedNode do begin
        if IsNamespaceNode
          then Result := TDomAttr.CreateNS(Self as TDomDocumentNS, NamespaceURI, NodeName, True)
          else Result := TDomAttr.Create(Self as TDomDocument, NodeName, True);
        Result.FNodeValue := FNodeValue;
      end;
    ntCDATA_Section_Node:
      begin
        Result := TDomCDATASection.Create(Self);
        (Result as TDomCDATASection).Data := (ImportedNode as TDomCDATASection).Data;
      end;
    ntComment_Node:
      begin
        Result := TDomComment.Create(Self);
        (Result as TDomComment).Data := (ImportedNode as TDomComment).Data;
      end;
    ntDocument_Fragment_Node:
      begin
        Result := TDomDocumentFragment.Create(Self);
        if Deep then for I := 0 to Pred(ImportedNode.ChildNodes.Length) do begin
          NewChild := ImportNode(ImportedNode.ChildNodes.Item(I), True);
          Result.AppendChild(NewChild);
        end;
      end;
    ntElement_Node:
      begin
        with ImportedNode do begin
          if IsNamespaceNode then begin
            Result := TDomElement.CreateNS(Self as TDomDocumentNS, NamespaceURI, NodeName);
            // Duplicating specified attributes:
            for I := 0 to Pred(ImportedNode.Attributes.Length) do begin
              OldAttr := TDomAttr(ImportedNode.Attributes.Item(I));
              if OldAttr.Specified then begin
                NewChild := ImportNode(OldAttr, True);
                (Result as TDomElement).SetAttributeNodeNS((NewChild as TDomAttr));
              end;
            end; {for ...}
          end else begin
            Result := TDomElement.Create(Self as TDomDocument, NodeName);
            // Duplicating specified attributes:
            for I := 0 to Pred(ImportedNode.Attributes.Length) do begin
              OldAttr := TDomAttr(ImportedNode.Attributes.Item(I));
              if OldAttr.Specified then begin
                NewChild := ImportNode(OldAttr, True);
                (Result as TDomElement).SetAttributeNode((NewChild as TDomAttr));
              end;
            end; {for ...}
          end;
        end; {if ... else ...}

        // Duplicating child nodes:
        if Deep then
          for I := 0 to Pred(ImportedNode.ChildNodes.Length) do begin
            NewChild := ImportNode(ImportedNode.ChildNodes.Item(I), True);
            Result.AppendChild(NewChild);
          end;
      end;
    ntEntity_Reference_Node:
      begin
        Result := TDomEntityReference.Create(Self, ImportedNode.NodeName);
        // Remark: Derived classes should implement entity reference expansion if possible.
      end;
    ntProcessing_Instruction_Node:
      begin
        Result := TDomProcessingInstruction.Create(Self, (ImportedNode as TDomProcessingInstruction).Target);
        (Result as TDomProcessingInstruction).Data := (ImportedNode as TDomProcessingInstruction).Data;
      end;
    ntText_Node:
      begin
        Result := TDomText.Create(Self);
        (Result as TDomText).Data := (ImportedNode as TDomText).Data;
        (Result as TDomText).CharRefGenerated := (ImportedNode as TDomText).CharRefGenerated;
      end;
  else
    raise ENot_Supported_Err.Create('Not supported error.');
  end;
end;

function TDomCustomDocument.GetBaseUri: WideString;
begin
  if IsUriAbsoluteURIWideStr(DocumentUri)
    then Result := DocumentUri
    else Result := '';
end;

function TDomCustomDocument.GetDoctypeDecl: TDomDocumentTypeDecl;
var
  Child: TDomNode;
begin
  Result := nil;
  Child := FirstChild;
  while Assigned(Child) do begin
    if Child.NodeType = ntDocument_Type_Decl_Node then begin
      Result := (Child as TDomDocumentTypeDecl);
      Break;
    end;
    Child := Child.NextSibling;
  end;
end;

function TDomCustomDocument.GetDocumentElement: TDomElement;
begin
  Result := FindFirstChildElement;
end;

function TDomCustomDocument.InsertBefore(const NewChild,
                                               RefChild: TDomNode): TDomNode;
begin
  if not Assigned(NewChild) then
    raise ENot_Supported_Err.Create('Not supported error.');
  case NewChild.NodeType of
    ntElement_Node: begin
      if Assigned(DocumentElement) then
        raise EHierarchy_Request_Err.Create('Hierarchy request error.');
      if Assigned(DoctypeDecl) then
        if ChildNodes.IndexOf(DoctypeDecl) >= ChildNodes.IndexOf(RefChild) then
          raise EHierarchy_Request_Err.Create('Hierarchy request error.');
    end;
    ntDocument_Type_Decl_Node: begin
      if Assigned(DocumentElement) then
        if ChildNodes.IndexOf(DocumentElement) < ChildNodes.IndexOf(RefChild) then
          raise EHierarchy_Request_Err.Create('Hierarchy request error.');
      if Assigned(DoctypeDecl) then
        raise EHierarchy_Request_Err.Create('Hierarchy request error.');
    end;
  end;
  Result := inherited InsertBefore(NewChild, RefChild);
end;

procedure TDomCustomDocument.NotifyIterators(const Node: TDomNode;
                                             const EventType: TDomNodeEvent);
var
  I: Integer;
begin
  for I := 0 to Pred(FCreatedNodeIterators.Count) do
    TDomNodeIterator(FCreatedNodeIterators[I]).HandleNodeEvent(Node, EventType);
end;

procedure CalcNormalizedAttrValue(const AttrLiteralValue: WideString;
                                  out NormalizedValue: WideString;
                                  out Error: TXmlErrorType;
                                  ProcessXmlSpaces: Boolean = TRUE;
                                  ReadLFOption: TCodecReadLFOption = lrNormalize);
const
  SPACE: WideChar = #$20;  // ' '
type
  TKindOfToken = (IS_TEXT, IS_REFSTART, IS_CHARREF, IS_ENTITYREF);
var
  CharRefStr: WideString;
  Text: TUtilsCustomWideStr;
  Tokenizer: TXmlAttrValueTokenizer;
begin
  Error := ET_NONE;
  Text := TUtilsCustomWideStr.Create;
  try

    Tokenizer := TXmlAttrValueTokenizer.Create(AttrLiteralValue, ReadLFOption);
    try
      with Tokenizer do begin
        while not (TokenType = ATTR_END_OF_SOURCE_TOKEN) do begin
          Next;

          if ErrorType <> ET_NONE then begin
            if ErrorType in ET_FATAL_ERRORS then begin
              Error := ErrorType;
              NormalizedValue := '';
              Exit;
            end;
            if not (Error in ET_ERRORS) then
              Error := ErrorType;
          end;

          case TokenType of

            ATTR_CHAR_REF:
              try
                CharRefStr := XmlCharRefToStr(Concat(WideString('&#'), TokenValue, WideString(';')));
                if CharRefStr = '<' then begin
                  Error := ET_LT_IN_ATTRIBUTE_VALUE;
                  Exit;
                end;
                Text.AddWideString(CharRefStr);
              except
                on EConvertError do begin
                  Error := ET_INVALID_CHAR_REF;
                  Exit;
                end;
              end;

            ATTR_ENTITY_REF:
              if TokenValue = 'lt' then begin
                Text.AddWideString('<');
              end else if TokenValue = 'gt' then begin
                Text.AddWideString('>');
              end else if TokenValue = 'amp' then begin
                Text.AddWideString('&');
              end else if TokenValue = 'apos' then begin
                Text.AddWideString('''');
              end else if TokenValue = 'quot' then begin
                Text.AddWideString('"');
              end else begin
                Error := ET_UNDEFINED_ENTITY_VC;
                Exit
              end;

            ATTR_TEXT:
              if ProcessXmlSpaces and IsXmlS(TokenValue)
                then Text.AddWideChar(SPACE)
                else Text.AddWideString(TokenValue);

          end; {case ...}

        end; {while ...}
      end; {with ...}
    finally
      Tokenizer.Free;
    end;

    NormalizedValue := Text.Value;

  finally
    Text.Free;
  end;
end;

procedure TDomCustomDocument.CalculateNormalizedAttrValue(const AttrLiteralValue: WideString;
                                                          const AttrDataType: TXmlDataType;
                                                            out NormalizedValue: WideString;
                                                            out Error: TXmlErrorType);
begin
  CalcNormalizedAttrValue(AttrLiteralValue, NormalizedValue, Error);
end;

procedure TDomCustomDocument.SetNodeValue(const Value: WideString);
begin
  // Do nothing.
end;

procedure TDomCustomDocument.FreeTreeWalker(var TreeWalker: TDomTreeWalker);
var
  TreeWalkerIndex: Integer;
begin
  if not Assigned(TreeWalker) then Exit;
  TreeWalkerIndex := FCreatedTreeWalkers.IndexOf(TreeWalker);
  if TreeWalkerIndex = -1
    then raise EWrong_Document_Err.Create('Wrong document error.');
  FCreatedTreeWalkers.Delete(TreeWalkerIndex);
  TreeWalker.Free;
  TreeWalker := nil;
end;

function TDomCustomDocument.ReplaceChild(const NewChild,
                                               OldChild: TDomNode): TDomNode;
begin
  if not ( Assigned(NewChild) and Assigned(OldChild) ) then
    raise ENot_Supported_Err.Create('Not supported error.');
  case NewChild.NodeType of
    ntElement_Node: begin
      if Assigned(DocumentElement) and (DocumentElement <> OldChild) then
        raise EHierarchy_Request_Err.Create('Hierarchy request error.');
      if Assigned(DoctypeDecl) then
        if ChildNodes.IndexOf(DoctypeDecl) > ChildNodes.IndexOf(OldChild) then
          raise EHierarchy_Request_Err.Create('Hierarchy request error.');
    end;
    ntDocument_Type_Decl_Node: begin
      if Assigned(DoctypeDecl) and (DoctypeDecl <> OldChild) then
        raise EHierarchy_Request_Err.Create('Hierarchy request error.');
      if Assigned(DocumentElement) then
        if ChildNodes.IndexOf(DocumentElement) < ChildNodes.IndexOf(OldChild) then
          raise EHierarchy_Request_Err.Create('Hierarchy request error.');
    end;
  end;
  Result := inherited ReplaceChild(NewChild, OldChild);
end;

function TDomCustomDocument.CreateNodeIterator(const Root: TDomNode;
                                                     WhatToShow: TDomWhatToShow;
                                                     NodeFilter: TDomNodeFilter;
                                                     EntityReferenceExpansion: Boolean): TDomNodeIterator;
begin
  Result := TDomNodeIterator.Create(Root, WhatToShow, NodeFilter, EntityReferenceExpansion);
  FCreatedNodeIterators.Add(Result);
end;

function TDomCustomDocument.CreateTreeWalker(const Root: TDomNode;
                                                   WhatToShow: TDomWhatToShow;
                                                   NodeFilter: TDomNodeFilter;
                                                   EntityReferenceExpansion: Boolean): TDomTreeWalker;
begin;
  Result := TDomTreeWalker.Create(Root, WhatToShow, NodeFilter, EntityReferenceExpansion);
  FCreatedTreeWalkers.Add(Result);
end;



//++++++++++++++++++++++++++++++ TDomDocument +++++++++++++++++++++++++++++++
constructor TDomDocument.Create(const AOwner: TDomImplementation);
begin
  inherited;
  FCreatedElementsNodeLists := TList.Create;
  FValidationAgent := TDtdValidationAgent.Create(Self);
end;

destructor TDomDocument.Destroy;
var
  I : Integer;
begin
  for I := 0 to Pred(FCreatedElementsNodeLists.Count) do
    TDomElementsNodeList(FCreatedElementsNodeLists[I]).Free;
  FCreatedElementsNodeLists.Free;

  FValidationAgent.Free;

  inherited;
end;

procedure TDomDocument.CalculateNormalizedAttrValue(const AttrLiteralValue: WideString;
                                                    const AttrDataType: TXmlDataType;
                                                      out NormalizedValue: WideString;
                                                      out Error: TXmlErrorType);
begin
  ValidationAgent.NormalizeAttributeValue(AttrLiteralValue, AttrDataType, NormalizedValue, Error);
end;

procedure TDomDocument.DoBeforeClear;
var
  I : Integer;
begin
  inherited;
  for I := 0 to Pred(FCreatedElementsNodeLists.Count) do
    TDomElementsNodeList(FCreatedElementsNodeLists[I]).Free;
  FCreatedElementsNodeLists.Clear;
end;

function TDomDocument.GetAttrDataType(const ElementName,
                                            AttrName: WideString): TXmlDataType;
begin
  Result := ValidationAgent.GetAttrDataType(ElementName, AttrName);
end;

function TDomDocument.GetElementById(const ElementId: WideString): TDomElement;
var
  Index: Integer;
begin
  if ValidationAgent.IDs.Find(ElementId, Index)
    then Result := TDomElement(ValidationAgent.IDs.Objects[Index])
    else Result := nil;
end;

function TDomDocument.GetElementsByTagName(const TagName: WideString): TDomNodeList;
var
  I: Integer;
begin
  for I := 0 to FCreatedElementsNodeLists.Count - 1 do
    if TDomElementsNodeList(FCreatedElementsNodeLists[I]).FQueryName = TagName
      then begin Result := TDomElementsNodeList(FCreatedElementsNodeLists[I]); Exit; end;
  Result := TDomElementsNodeList.Create(TagName, Self);
  FCreatedElementsNodeLists.Add(Result);
end;

function TDomDocument.GetIsElementContentWhitespace(const TextNode: TDomText): Boolean;
var
  P: TDomNode;
begin
  Result := False;
  with TextNode do
    if not CharRefGenerated then  // Was TextNode generated from at least one character reference?
      if (IsXMLS(NodeValue) or (NodeValue = '')) then begin  // Does TextNode contain whitespace only?
        P := ParentNode;
        while Assigned(P) do
          case P.NodeType of
            ntElement_Node: begin
              Result := ValidationAgent.GetElementContentType((P as TDomElement).NodeName) = DTD_ELEMENT_CONTENTTYPE;
              Break;
            end;
            ntEntity_Reference_Node:
              P := P.ParentNode;
          else
            Break;
          end;
      end;
end;

function TDomDocument.ImportNode2(const ImportedNode: TDomNode;
                                  const Deep: Boolean): TDomNode;
begin
  Result := inherited ImportNode2(ImportedNode, Deep);
  if Result.NodeType = ntEntity_Reference_Node then
    ValidationAgent.ExpandEntityReference(Result as TDomEntityReference);
end;

function TDomDocument.PrepareAttributes: Boolean;
begin
  if Assigned(DocumentElement)
    then Result := PrepareAttributes2(DocumentElement)
    else Result := True;
end;

function TDomDocument.PrepareAttributes2(const Node: TDomNode): Boolean;
var
  Attr: TDomAttr;
  I: Integer;
begin
  Result := True;
  with Node do begin

    if NodeType = ntElement_Node then begin

      if IsNamespaceNode then
        Result := False;


      // Step 1: Remove all TDomAttr nodes attached to this element whose
      //         'Specified' property is 'False'.

      for I := Pred(Attributes.Length) downto 0 do begin
        Attr := Attributes.Item(I) as TDomAttr;
        if not Attr.Specified then
          Attr.Free;  // Removes and frees the attribute node.
      end;


      // Step 2: Create and add missing fixed and default TDomAttr nodes with
      //         'Specified' set to 'False'.

      ValidationAgent.AddDefaultAttributes(Node as TDomElement);

    end;

    
    // Step 3: Prepare the attributes of the child nodes.

    for I := 0 to Pred(Childnodes.Length) do
      if not PrepareAttributes2(Childnodes.Item(I)) then
        Result := False;
  end;
end;



//+++++++++++++++++++++++++++++ TDomDocumentNS ++++++++++++++++++++++++++++++
constructor TDomDocumentNS.Create(const AOwner: TDomImplementation);
begin
  inherited;
  FCreatedElementsNodeListNSs:= TList.Create;
  FIDs:= TUtilsWideStringList.Create;
  FIDs.Sorted:= True;
  FIDs.Duplicates:= dupIgnore;
end;

destructor TDomDocumentNS.Destroy;
var
  I : Integer;
begin
  for I := 0 to Pred(FCreatedElementsNodeListNSs.Count) do
    TDomElementsNodeListNS(FCreatedElementsNodeListNSs[I]).Free;
  FCreatedElementsNodeListNSs.Free;

  FIDs.Free;

  inherited;
end;

procedure TDomDocumentNS.DoBeforeClear;
var
  I : Integer;
begin
  inherited;
  for I := 0 to Pred(FCreatedElementsNodeListNSs.Count) do
    TDomElementsNodeListNS(FCreatedElementsNodeListNSs[I]).Free;
  FCreatedElementsNodeListNSs.Clear;
end;

function TDomDocumentNS.GetElementById(const ElementId: WideString): TDomElement;
var
  Index: Integer;
begin
  if IDs.Find(ElementId, Index)
    then Result := TDomElement(IDs.Objects[Index])
    else Result := nil;
end;

function TDomDocumentNS.GetElementsByTagNameNS(const NamespaceURI,
                                                     LocalName: WideString): TDomNodeList;
var
  I: Integer;
  NL: TDomElementsNodeListNS;
begin
  for I := 0 to FCreatedElementsNodeListNSs.Count - 1 do begin
    NL := TDomElementsNodeListNS(FCreatedElementsNodeListNSs[I]);
    if (NL.FQueryNamespaceURI = NamespaceURI) and (NL.FQueryLocalName = LocalName)
      then begin Result := NL; Exit; end;
  end;
  Result := TDomElementsNodeListNS.Create(NamespaceURI, LocalName, Self);
  FCreatedElementsNodeListNSs.Add(Result);
end;

procedure TDomDocumentNS.SetIDs(const Value: TUtilsWideStringList);
begin
  FIDs.Assign(Value);
end;



//++++++++++++++++++++++++++++ TDomDocumentXPath ++++++++++++++++++++++++++++
procedure TDomDocumentXPath.DoBeforeAttach(const Obj: TCustomOwnedObject);
begin
  if not ( (Obj is TDomDocumentFragment) or
           (Obj is TDomProcessingInstruction) or
           (Obj is TDomElement) or
           (Obj is TDomAttr) or
           (Obj is TDomComment) or
           (Obj is TDomText) ) then
    raise ENot_Supported_Err.Create('Not supported error.');

  inherited;
end;



//+++++++++++++++++++++++++++++ TDtdObjectList ++++++++++++++++++++++++++++
constructor TDtdObjectList.Create;
begin
  inherited Create;
  FNodeList:= TList.Create;
end;

destructor TDtdObjectList.Destroy;
begin
  FNodeList.Free;
  inherited;
end;

procedure TDtdObjectList.Clear;
begin
  FNodeList.Clear;
end;

function TDtdObjectList.AppendNode(const NewNode: TDtdObject): TDtdObject;
begin
  FNodeList.Add(NewNode);
  Result := NewNode;
end;

procedure TDtdObjectList.Delete(const Index: Integer);
begin
  FNodeList.Delete(Index);
end;

function TDtdObjectList.IndexOf(const Node: TDtdObject): Integer;
begin
  Result := FNodeList.IndexOf(Node);
end;

function TDtdObjectList.GetLength: Integer;
begin
  Result := FNodeList.Count;
end;

function TDtdObjectList.InsertBefore(const NewNode,
                                             RefNode: TDtdObject): TDtdObject;
begin
  Result := NewNode;
  with FNodeList do
    if Assigned(RefNode)
      then Insert(IndexOf(RefNode), NewNode)
      else Add(NewNode);
end;

function TDtdObjectList.RemoveNode(const OldNode: TDtdObject): TDtdObject;
begin
  Result := OldNode;
  FNodeList.Remove(OldNode);
end;

function TDtdObjectList.Item(const Index: Integer): TDtdObject;
begin
  if (Index < 0) or (Index >= FNodeList.Count)
    then Result := nil
    else Result := TDtdObject(FNodeList.Items[Index]);
end;



//+++++++++++++++++++++++++ TDtdNamedObjectMap +++++++++++++++++++++++++
constructor TDtdNamedObjectMap.Create(const AOwner: TDtdModel);
begin
  inherited Create;
  FOwnerObject:= AOwner;
  FObjectList:= TList.Create;
end;

destructor TDtdNamedObjectMap.Destroy;
begin
  FObjectList.Free;
  inherited;
end;

procedure TDtdNamedObjectMap.Clear;
begin
  FObjectList.Clear;
end;

function TDtdNamedObjectMap.GetLength: Integer;
begin
  Result := FObjectList.Count;
end;

function TDtdNamedObjectMap.GetNamedItem(const Name: WideString): TDtdObject;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Pred(FObjectList.Count) do
    if (TDtdObject(FObjectList[I]).Name = Name) then begin
      Result := TDtdObject(FObjectList[I]);
      Break;
    end;
end;

function TDtdNamedObjectMap.Item(const Index: Integer): TDtdObject;
begin
  if (Index < 0) or (Index >= FObjectList.Count)
    then Result := nil
    else Result := TDtdObject(FObjectList.Items[Index]);
end;

function TDtdNamedObjectMap.RemoveNamedItem(const Name: WideString): TDtdObject;
begin
  Result := GetNamedItem(Name);
  if not Assigned(Result) then
    raise ENot_Found_Err.Create('Not found error.');
  FObjectList.Remove(Result);
end;

function TDtdNamedObjectMap.SetNamedItem(const Arg: TDtdObject): TDtdObject;
begin
  if Assigned(GetNamedItem(Arg.Name))
    then Result := RemoveNamedItem(Arg.Name)
    else Result := nil;
  FObjectList.Add(Arg);
end;



//++++++++++++++++++++++ TDtdValidationAgent ++++++++++++++++++++++++++
constructor TDtdValidationAgent.Create(const AOwner: TDomDocument);
begin
  if not Assigned(AOwner) then
    raise ENot_Supported_Err.Create('Not supported error.');
  inherited Create;

  FOwnerDocument := AOwner;

  FIDs := TUtilsWideStringList.Create;
  FIDs.Sorted := True;
  FIDs.Duplicates := dupError;

  FIDREFs := TUtilsWideStringList.Create;
  FIDREFs.Sorted := False;
  FIDREFs.Duplicates := dupAccept;

  FDtdModel := TDtdModel.Create;
end;

destructor TDtdValidationAgent.Destroy;
begin
  FDtdModel.Free;
  FIDREFs.Free;
  FIDs.Free;
  inherited;
end;

procedure TDtdValidationAgent.AddDefaultAttr(const Elmt: TDomElement;
                                             const AttrName,
                                                   AttrValue: WideString);
// Adds a new attribute (with specified set to False) to Elmt, no matter whether
// Elmt is readonly or not.
var
  NewAttr: TDomAttr;
  ReadOnlyBackup: Boolean;
begin
  NewAttr := TDomAttr.Create(Elmt.OwnerDocument as TDomDocument, AttrName, False);
  NewAttr.NodeValue := AttrValue;
  ReadOnlyBackup := Elmt.IsReadOnly;
  Elmt.SetReadOnly(False);
  try
    Elmt.SetAttributeNode(NewAttr);
  finally
    Elmt.SetReadOnly(ReadOnlyBackup);
  end;
end;

function TDtdValidationAgent.AddDefaultAttributes(const Elmt: TDomElement): Boolean;
// Adds missing default attributes to an element, checks whether the value of
// all fixed attributes match and whether all required attributes are specified.
// Return value:
//   'True' if all attributes to be inserted were actually inserted.
//   'False' if an attribute was skipped due to a malformed declaration.
var
  AttrDecl: TDtdAttributeDecl;
  NormalizedDefaultValue: WideString;
  AttDeclCol: TDtdAttDeclCollection;
  Error: TXmlErrorType;
  I: Integer;
  SpecifiedAttr: TDomAttr;
begin
  Assert(Assigned(Elmt));

  Result := True;

  AttDeclCol := DtdModel.FindAttDeclCollection(Elmt.NodeName);
  if Assigned(AttDeclCol) then
    with AttDeclCol.AttributeDecls do
      for I := 0 to Pred(Length) do begin

        AttrDecl := Item(I) as TDtdAttributeDecl;
        if AttrDecl.ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin

          SpecifiedAttr := Elmt.GetAttributeNode(AttrDecl.Name);

          // If the attribute was not specified, then set it:
          if not Assigned(SpecifiedAttr) then begin
            NormalizeAttrDeclValue(AttrDecl, NormalizedDefaultValue, Error);
            if Error in ET_WARNINGS
              then AddDefaultAttr(Elmt, AttrDecl.Name, NormalizedDefaultValue)
              else Result := False;
          end;

        end;

      end; {for ...}
end;

procedure TDtdValidationAgent.AddAndValidateDefaultAttributes(const Elmt: TDomElement;
                                                                out IsValid,
                                                                    AContinue: Boolean);
// Adds missing default attributes to an element, checks whether the value of
// all fixed attributes match and whether all required attributes are specified.
// Return Values:
// - IsValid: Indicates whether the element is valid according to some tests
//            made in this subroutine.
// - AContinue: 'False' to indicate that the validation should be aborted.
var
  AttrDecl: TDtdAttributeDecl;
  AttDeclCol: TDtdAttDeclCollection;
  Error: TXmlErrorType;
  I: Integer;
  NormalizedAttrValue: WideString;
  NormalizedDefaultValue: WideString;
  SpecifiedAttr: TDomAttr;
begin
  Assert(Assigned(Elmt));

  AContinue := True;
  IsValid := True;
  AttDeclCol := DtdModel.FindAttDeclCollection(Elmt.NodeName);
  if Assigned(AttDeclCol) then begin
    with AttDeclCol.AttributeDecls do begin
      for I := 0 to Pred(Length) do begin
        AttrDecl := Item(I) as TDtdAttributeDecl;
        case AttrDecl.ConstraintType of

          AVC_DEFAULT:
          begin
            SpecifiedAttr := Elmt.GetAttributeNode(AttrDecl.Name);

            // If the attribute was not specified, then set it:
            if not Assigned(SpecifiedAttr) then begin
              NormalizeAttrDeclValue(AttrDecl, NormalizedDefaultValue, Error);
              if Error in ET_WARNINGS then begin
                AddDefaultAttr(Elmt, AttrDecl.Name, NormalizedDefaultValue);
              end else begin
                IsValid := False;
                if not SendErrorNotification(Error, AttrDecl, Elmt) then begin
                  AContinue := False;
                  Exit;
                end;
              end;
            end;

          end;

          AVC_FIXED: // VC: Fixed Attribute Default (XML 1.0, § 3.3.2)
          begin
            NormalizeAttrDeclValue(AttrDecl, NormalizedDefaultValue, Error);
            if Error in ET_WARNINGS then begin

              SpecifiedAttr := Elmt.GetAttributeNode(AttrDecl.Name);
              if Assigned(SpecifiedAttr) then begin
                // Check whether the specified attribute value and the
                // default value of the attribute declaration match:
                NormalizeAttributeValue(SpecifiedAttr.NodeValue, AttrDecl.AttrType, NormalizedAttrValue, Error);
                if not (Error in ET_WARNINGS) or
                   not (NormalizedAttrValue = NormalizedDefaultValue) then
                begin
                  IsValid := False;
                  if not SendErrorNotification(ET_FIXED_ATTRIBUTE_MISMATCH, AttrDecl, Elmt) then begin
                    AContinue := False;
                    Exit;
                  end;
                end;
              end else
                AddDefaultAttr(Elmt, AttrDecl.Name, NormalizedDefaultValue);

            end else begin
              IsValid := False;
              if not SendErrorNotification(Error, AttrDecl, Elmt) then begin
                AContinue := False;
                Exit;
              end;
            end;
          end;

          AVC_REQUIRED: // VC: Required Attribute (XML 1.0, § 3.3.2)
          begin
            if not Elmt.HasAttribute(AttrDecl.Name) then begin
              IsValid := False;
              if not SendErrorNotification(ET_REQUIRED_ATTRIBUTE_NOT_SPECIFIED, AttrDecl, Elmt) then begin
                AContinue := False;
                Exit;
              end;
            end;
          end;

        end; {case ...}
      end; {for ...}
    end; {with ...}
  end; {if ...}
end;

procedure TDtdValidationAgent.Clear;
begin
  FDtdModel.Clear;
  FIDs.Clear;
  FIDREFs.Clear;
end;

function TDtdValidationAgent.DocumentIsStandalone: Boolean;
// Returns 'True' if the document has no DTD or it has only an internal DTD
// subset which contains no parameter entity references or if standalone status
// of the document is 'yes'.  Otherwise 'False' is returned.
begin
  Assert(Assigned(OwnerDocument));

  with OwnerDocument do begin
    if Assigned(DoctypeDecl) then begin
      if (DoctypeDecl.PublicId = '') and (DoctypeDecl.SystemId = '') then begin
        Result := not DtdModel.PEsInIntSubset; 
      end else
        Result := XmlStandalone = STANDALONE_YES;
    end else
      Result := True;
  end;
end;

function TDtdValidationAgent.ExpandEntityReference(const EntRef: TDomEntityReference): TXmlErrorType;
var
  DocFrag: TDomDocumentFragment;
  Dummy1: Boolean;
  Dummy2: Int64;
  ReplacementText: WideString;
begin
  EntRef.SetReadOnly(False);
  try
    EntRef.Clear;

    Result := FindEntityReplacementText(EntRef.NodeName, ReplacementText, Dummy1, Dummy2);
    if (Result in ET_WARNINGS) then begin
      try
        DocFrag := ParseWideString(ReplacementText);
        try
          EntRef.AppendChild(DocFrag);
        finally
          DocFrag.Free;
        end;
      except
        Result := ET_NO_PROPER_MARKUP_REFERENCED;  
      end;
    end;

    EntRef.MakeChildrenReadOnly;

  finally
    EntRef.SetReadOnly(True);
  end;
end;

function TDtdValidationAgent.FindAttributeDecl(const ElementName,
                                                     AttributeName: WideString): TDtdAttributeDecl;
begin
  Result := DtdModel.FindAttributeDecl(ElementName, AttributeName);
end;

function TDtdValidationAgent.FindElementDecl(const Name: WideString): TDtdElementDecl;
begin
  Result := DtdModel.FindElementDecl(Name);
end;

function TDtdValidationAgent.FindEntityDecl(const Name: WideString): TDtdEntityDecl;
begin
  Result := DtdModel.FindEntityDecl(Name);
end;

function TDtdValidationAgent.FindEntityReplacementText(const EntityName: WideString;
                                                         out ReplText: WideString;
                                                         out IsExternalEntity: Boolean;
                                                         out Key: Int64): TXmlErrorType;
var
  EntDecl: TDtdEntityDecl;
begin
  Assert(Assigned(OwnerDocument));

  IsExternalEntity := False;
  Key := 0; // The Key return value must be 0 if no entity declaration was fount.
  EntDecl := FindEntityDecl(EntityName);

  if Assigned(EntDecl) then begin

    IsExternalEntity := EntDecl.EntityType = DTD_EXTERNAL_ENTITY;
    Key := EntDecl.Key;

    Result := EntDecl.ResolveReplacementText(ResolveEntity);
    if not (Result in ET_WARNINGS) then begin
      ReplText := '';
      Exit;
    end;

    if not EntDecl.CheckNoRecursion then begin
      ReplText := '';
      Result := ET_RECURSIVE_REFERENCE;
    end else begin
      Result := ET_NONE;
      ReplText := EntDecl.ReplacementText;
      if EntDecl.Origin = DTD_EXTERNALLY_DECLARED then begin
        if DocumentIsStandalone then
          // WFC: Entity declared (XML 1.0, § 4.1)
          Result := ET_EXT_DECL_ENTITY_REFERENCED_IN_STANDALONE_DOC;
      end;
    end;

  end else begin

    ReplText := '';
    if DocumentIsStandalone then begin
      // WFC: Entity declared (XML 1.0, § 4.1)
      Result := ET_UNDEFINED_ENTITY_WFC;
    end else begin
      // VC: Entity declared (XML 1.0, § 4.1)
      Result := ET_UNDEFINED_ENTITY_VC;
    end;

  end;
end;

function TDtdValidationAgent.FindNotationDecl(const Name: WideString): TDtdNotationDecl;
begin
  Result := DtdModel.FindNotationDecl(Name);
end;

function TDtdValidationAgent.GetAttrDataType(const ElementName,
                                                   AttrName: WideString): TXmlDataType;
var
  AttrDecl: TDtdAttributeDecl;
begin
  AttrDecl := DtdModel.FindAttributeDecl(ElementName, AttrName);
  if Assigned(AttrDecl)
    then Result := AttrDecl.AttrType
    else Result := AS_STRING_DATATYPE;
end;

function TDtdValidationAgent.GetDomImplementation: TDomImplementation;
begin
  Assert(Assigned(OwnerDocument));
  Result := OwnerDocument.DomImplementation;
end;

function TDtdValidationAgent.GetElementContentType(const ElementName: WideString): TDtdContentType;
var
  E_Decl: TDtdElementDecl;
begin
  E_Decl := FindElementDecl(ElementName);
  if Assigned(E_Decl)
    then Result := E_Decl.ContentType
    else Result := DTD_ANY_CONTENTTYPE;
end;

procedure TDtdValidationAgent.NormalizeAttrValueStep1(const S: WideString;
                                                      const AttrDeclKey: Int64;
                                                        out S_Normalized: WideString;
                                                        out Error: TXmlErrorType);
// This method performs the first steps of attribute value normalization (see
// XML 1.0, sec. 3.3.3).  All line breaks in 'S' must have been normalized to
// #xA. The function starts with a normalized value consisting of the empty
// WideString. For each character, entity reference, or character reference in
// the unnormalized attribute value, beginning with the first and continuing to
// the last, it does the following:
//
// - For a character reference, it appends the referenced character to the
//   normalized value.
// - For an entity reference, it recursively applies this step to the
//   replacement text of the entity.
// - For a white space character (#x20, #xD, #xA, #x9), it appends a space
//   character (#x20) to the normalized value.
// - For another character, it appends the character to the normalized value.
//
// The AttrDeclKey parameter indicates whether the value of an (ordinary)
// attribute is to be normalized (AttrDeclKey = 0) or the default value of an
// attribute definition (AttrDeclKey > 0).  References to external
// entities are not allowed in attribute values, but they are allowed in
// default values of attribute definitions (see XML 1.0, sec. 3.1).  The
// declaration of a general entity must precede any attribute-list declaration
// containing a default value with a direct or indirect reference to that
// general entity (see XML 1.0, sec. 4.1).

const
  SPACE: WideChar = #$20; // ' '
  LT:    WideChar = #$3C; // '<'
type
  TKindOfToken = (IS_TEXT, IS_REFSTART, IS_CHARREF, IS_ENTITYREF);
var
  CharRefStr: WideString;
  EntityKey: Int64;
  IsExternalEntity: Boolean;
  NormalizedReplacementText: WideString;
  ReplacementText: WideString;
  Text: TUtilsCustomWideStr;
  Tokenizer: TXmlAttrValueTokenizer;
begin
  Error := ET_NONE;
  Text := TUtilsCustomWideStr.Create;
  try

    Tokenizer := TXmlAttrValueTokenizer.Create(S);
    try
      with Tokenizer do begin
        while not (TokenType = ATTR_END_OF_SOURCE_TOKEN) do begin
          Next;

          if ErrorType <> ET_NONE then begin
            if ErrorType in ET_FATAL_ERRORS then begin
              Error := ErrorType;
              S_Normalized := '';
              Exit;
            end;
            if not (Error in ET_ERRORS) then
              Error := ErrorType;
          end;

          case TokenType of

            ATTR_CHAR_REF:
              try
                CharRefStr := XmlCharRefToStr(Concat(WideString('&#'), TokenValue, WideString(';')));
                Text.AddWideString(CharRefStr);
              except
                on EConvertError do begin
                  Error := ET_INVALID_CHAR_REF;
                  Exit;
                end;
              end;

            ATTR_ENTITY_REF: begin
              Error := FindEntityReplacementText(TokenValue,
                         ReplacementText, IsExternalEntity, EntityKey);

              // AttrDeclKey = 0 means that we are processing an (ordinary)
              // attribute value, not the default value of an attribute
              // definition.
              if AttrDeclKey = 0 then begin
                if IsExternalEntity then begin
                  // WFC: No External Entity Reference (XML 1.0, § 3.1)
                  Error := ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY;
                  Exit;
                end;
              end;

              if not (Error in  ET_WARNINGS) then
                // VC: Entity declared (XML 1.0, § 4.1)
                Exit;

              if Pos(LT, ReplacementText) <> 0 then begin
                // WFC: No < in Attribute Values (XML 1.0, § 3.1)
                Error := ET_LT_IN_ATTRIBUTE_VALUE;
                Exit;
              end;

              if (AttrDeclKey > 0) and (EntityKey > AttrDeclKey) then begin
                if DocumentIsStandalone then begin
                  // WFC: Entity declared (XML 1.0, § 4.1)
                  Error := ET_ENTITY_REFERENCED_BEFORE_DECLARED_WFC;
                end else begin
                  // VC: Entity declared (XML 1.0, § 4.1)
                  Error := ET_ENTITY_REFERENCED_BEFORE_DECLARED_VC;
                end;
                Exit;
              end;

              NormalizeAttrValueStep1(ReplacementText, AttrDeclKey,
                                      NormalizedReplacementText, Error);

              if not (Error in  ET_WARNINGS) then
                Exit;
              Text.AddWideString(NormalizedReplacementText);
            end;

            ATTR_TEXT:
              if IsXmlS(TokenValue)
                then Text.AddWideChar(SPACE)
                else Text.AddWideString(TokenValue);

          end; {case ...}

        end; {while ...}
      end; {with ...}
    finally
      Tokenizer.Free;
    end;

    S_Normalized := Text.Value;

  finally
    Text.Free;
  end;
end;

procedure TDtdValidationAgent.NormalizeValue(const AttrLiteralValue: WideString;
                                             const AttrDataType: TXmlDataType;
                                             const AttrDeclKey: Int64;
                                               out NormalizedValue: WideString;
                                               out Error: TXmlErrorType);
var
  S: WideString;
begin
  if AttrDataType = AS_STRING_DATATYPE then begin
    NormalizeAttrValueStep1(AttrLiteralValue, AttrDeclKey, NormalizedValue, Error);
  end else begin
    NormalizeAttrValueStep1(AttrLiteralValue, AttrDeclKey, S, Error);
    // Further attribute normalization (See XML 1.0, § 3.3.3):
    NormalizedValue := NormalizeSpace(S);
  end;
end;

procedure TDtdValidationAgent.NormalizeAttributeValue(const AttrLiteralValue: WideString;
                                                      const AttrDataType: TXmlDataType;
                                                        out NormalizedValue: WideString;
                                                        out Error: TXmlErrorType);
begin
  NormalizeValue(AttrLiteralValue, AttrDataType, 0, NormalizedValue, Error);
end;

procedure TDtdValidationAgent.NormalizeAttrDeclValue(const AttrDecl: TDtdAttributeDecl;
                                                       out NormalizedValue: WideString;
                                                       out Error: TXmlErrorType);
begin
  NormalizeValue(AttrDecl.DefaultValue, AttrDecl.AttrType, AttrDecl.Key, NormalizedValue, Error);
end;

procedure TDtdValidationAgent.BuildDtdModel(const ResolveExtEntities: Boolean);
const
  BUFFER_SIZE: Integer = 4096;
var
  DtdToDtdModelParser: TDtdToDtdModelParser;
begin
  Assert(Assigned(OwnerDocument));

  Clear;
  if Assigned(OwnerDocument.DoctypeDecl) then begin
    DtdToDtdModelParser := TDtdToDtdModelParser.Create(nil);
    try
      DtdToDtdModelParser.DOMImpl := DomImplementation;
      DtdToDtdModelParser.BufferSize := BUFFER_SIZE;
      DtdToDtdModelParser.TargetDtdModel := DtdModel;
      DtdToDtdModelParser.ParseDocTypeDecl(OwnerDocument.DoctypeDecl, ResolveExtEntities);
    finally
      DtdToDtdModelParser.Free;
    end;
  end else
    DtdModel.PreparationStatus := PS_INEXISTANT;
end;

function TDtdValidationAgent.ParseWideString(const S: WideString): TDomDocumentFragment;
var
  InputSource: TXmlSimpleInputSource;
  Parser: TXmlToDomParser;
  WStrStream: TUtilsWideStringStream;
begin
  Result := TDomDocumentFragment.Create(OwnerDocument);
  try
    WStrStream := TUtilsWideStringStream.Create(S);
    try
      Parser := TXmlToDomParser.Create(nil);
      try
        Parser.DOMImpl := DomImplementation;
        InputSource := TXmlSimpleInputSource.Create(WStrStream, '', '',
                         Parser.BufferSize, TUTF16LECodec, 0, 0, 0, 0, 1);
        try
          Parser.ParseFragment(InputSource, Result);
        finally
          InputSource.Free;
        end;
      finally
        Parser.Free;
      end;
    finally
      WStrStream.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure TDtdValidationAgent.ResolveEntity(const Origin: TDtdOrigin;
                                            const BaseURI,
                                                  PubId,
                                                  SysId: WideString;
                                              out ReplacementText: WideString;
                                              out Error: TXmlErrorType);
// Resolves an entity resource as a WideString.  Used as call-back function for
// TDtdEntityDecl.Resolve function calls.
//
// Parameters:
// - Origin
//    DTD_EXTERNALLY_DECLARED, if the declaration of the external entity appeared
//    in the external subset of a DTD or in a parameter entity (external or
//    internal, the latter being included because non-validating processors are
//    not required to read them); DTD_INTERNALLY_DECLARED otherwise.
// - BaseURI
//    The base URI of the resource to retrieve.
// - PubId
//    The public identifier of the external entity to be resolved, or an empty
//    WideString, if the public identifier is unknown.
// - SysId
//    The system identifier of the external entity to be resolved, or an empty
//    WideString, if the system identifier is unknown.
// - ReplacementText
//    The replacement text of the entity as a WideString, if available.
// - Error
//    If an attempt to resolve an entity failed the Error parameter returns the
//    error code indicating the type of the error.  If no error occurred ET_NONE
//    is returned.
var
  PId: WideString;
  SId: WideString;
begin
  if not Assigned(DomImplementation) then begin
    ReplacementText := '';
    Error := ET_EXT_ENTITY_RESOURCE_NOT_FOUND;
    Exit;
  end;

  PId := PubId;
  // Calculate absolute system identifier:
  ResolveRelativeUriWideStr(BaseUri, SysId, SId);
     // Remark: Returns an empty SId if ResolveRelativeUriWideStr attempt fails.

  if Origin = DTD_INTERNALLY_DECLARED
    then DomImplementation.ResolveResourceAsWideString(DtdModel.IntSubsetSysId, PId, SId, ReplacementText, Error)
    else DomImplementation.ResolveResourceAsWideString(DtdModel.ExtSubsetSysId, PId, SId, ReplacementText, Error);
end;

function TDtdValidationAgent.SendErrorNotification(const XmlErrorType: TXmlErrorType;
                                                   const RelDtdObject: TDtdObject;
                                                   const RelNode: TDomNode): Boolean;
// Used to centralize code for sending error notifications to the DomImplementation.
// Usually used during validation.
var
  Error: TDomError;
begin
  Error := TDomError.Create(XmlErrorType, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
                            '', RelDtdObject, RelNode, '', '');
  try
    if Assigned(DomImplementation) then begin
      Result := DomImplementation.HandleError(Self, Error);
    end else if Error.Severity = DOM_SEVERITY_FATAL_ERROR
      then Result := False
      else Result := True;
  finally
    Error.Free;
  end;
end;

procedure TDtdValidationAgent.ValidateAttr(const Attr: TDomAttr;
                                           const Opt: TDomEntityResolveOption;
                                             out IsValid,
                                                 AContinue: Boolean);
// Return Values:
// - IsValid: Indicates whether the element is valid according to some tests
//            made in this subroutine.
// - AContinue: 'False' to indicate that the validation should be aborted.

  function HasAttrEnum(const AttriDecl: TDtdAttributeDecl;
                       const AttriValue: WideString): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    with AttriDecl do begin
      if Enumeration.Count = 0 then
        Result := True;
      for I := 0 to Pred(Enumeration.Count) do
        if Enumeration[I] = AttriValue then begin
          Result := True;
          Break;
        end;
    end;
  end;

  function HasUnparsedEntity(const EntityName: WideString): Boolean;
  var
    EntityDecl: TDtdEntityDecl;
  begin
    EntityDecl := FindEntityDecl(EntityName);
    if Assigned(EntityDecl)
      then Result := not EntityDecl.IsParsedEntity
      else Result := False;
  end;

const
  NULL: WideChar = #$0;  // End of WideString mark
  SPACE: WideChar  = #$20;
var
  Error: TXmlErrorType;
  I, StartIndex, IndexCount: Integer;
  AttriDecl: TDtdAttributeDecl;
  NormalizedValue: WideString;
  P: PWideChar;
  StandaloneValue: WideString;
  S: WideString;
  Target: TUtilsCustomWideStr;
begin
  Assert(Assigned(Attr));
  Assert(Assigned(Attr.OwnerElement));
  AContinue := True;
  IsValid := True;

  // VC: Entity declared (XML 1.0, § 4.1)
  // WFC: No External Entity Reference (XML 1.0, § 3.1)
  // WFC: No < in Attribute Values (XML 1.0, § 3.1)
  NormalizeAttributeValue(Attr.NodeValue, Attr.DataType, NormalizedValue, Error);
  if not (Error = ET_NONE) then begin
    if not (Error in ET_WARNINGS) then
      IsValid := False;
    if not SendErrorNotification(Error, nil, Attr) then begin
      AContinue := False;
      Exit;
    end;
  end;

  // VC: Attribute Value Type (XML 1.0, § 3.1)
  AttriDecl := FindAttributeDecl(Attr.OwnerElement.NodeName, Attr.NodeName);
  if not Assigned(AttriDecl) then begin
    IsValid := False;
    if not SendErrorNotification(ET_UNDEFINED_ATTRIBUTE, nil, Attr) then
      AContinue := False;
    Exit;  // Exit even if SendErrorNotification returned 'True',
           // because AttriDecl must be assigned for the following operations.
  end;

  // VC: Standalone Document Declaration (XML 1.0, § 2.9)
  if AttriDecl.Origin = DTD_EXTERNALLY_DECLARED then
    if DocumentIsStandalone then begin

      if not Attr.Specified then begin
        IsValid := False;
        if not SendErrorNotification(ET_UNSPECIFIED_EXT_ATTR_IN_STANDALONE_DOC, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;

      // Calculate the replacement text of the attribute as if no type information had been provided:
      NormalizeAttrValueStep1(Attr.NodeValue, 0, StandaloneValue, Error);
      if Error in ET_WARNINGS then
        if StandaloneValue <> NormalizedValue then begin
          IsValid := False;
          if not SendErrorNotification(ET_UNNORMALIZED_EXT_ATTR_IN_STANDALONE_DOC, AttriDecl, Attr) then begin
            AContinue := False;
            Exit;
          end;
        end;
        // Remark: Errors encoutered during NormalizeAttrValueStep1 are
        // not considered, because that has been done after the call to
        // NormalizeAttributeValue above.

    end;



  // Resolve Entity References
  //
  // If the Opt parameter is 'erReplace' the literal value of the TDomAttr is
  // replaced with its normalized value which is modified as follows:
  // All ampersands (&) are replaced with &amp;, all open angle brackets (<)
  // with &lt;, all quotation mark characters with &quot;, and the whitespace
  // characters #x9, #xA, and #xD, with character references. The character
  // references are written in uppercase hexadecimal with no leading zeroes (for
  // example, #xD is represented by the character reference &#xD;).
  if Opt = erReplace then begin
    Target := TUtilsCustomWideStr.Create;
    try
      P := PWideChar(NormalizedValue);
      while P^ <> NULL do begin
        case Ord(P^) of
          TAB: Target.AddWideString('&#x9;');
          LF:  Target.AddWideString('&#xA;');
          CR:  Target.AddWideString('&#xD;');
          DQ:  Target.AddWideString('&quot;');
          AMP: Target.AddWideString('&amp;');
          LT:  Target.AddWideString('&lt;');
        else
          Target.AddWideChar(P^);
        end;
        Inc(P)
      end;
      Attr.NodeValue := Target.Value;
    finally
      Target.Free;
    end;
  end;

  // VC: Attribute Value Type (XML 1.0, § 3.1)
  case AttriDecl.AttrType of

    AS_STRING_DATATYPE:
    begin
      // VC: XML Schema Part 2: Datatypes: Strings
      if not IsXMLChars(NormalizedValue) then begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
    end;

    AS_NOTATION_DATATYPE:
    begin
      // VC: Notation Attributes (XML 1.0, § 3.3.1)
      if not HasAttrEnum(AttriDecl, NormalizedValue) then begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
    end;

    AS_ID_DATATYPE:
    begin
      // VC: Entity (XML 1.0, § 3.3.1)
      if not IsXMLName(NormalizedValue) then begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;

      try
        FIDs.AddObject(NormalizedValue, Attr.OwnerElement);
      except
        // VC: ID (XML 1.0, § 3.3.1)
        on EStringListError do begin
          IsValid := False;
          if not SendErrorNotification(ET_DUPLICATE_ID_VALUE, AttriDecl, Attr) then begin
            AContinue := False;
            Exit;
          end;
        end;
      end;
    end;

    AS_IDREF_DATATYPE:
    begin
      // VC: Entity (XML 1.0, § 3.3.1)
      if not IsXMLName(NormalizedValue) then begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
      
      FIDREFs.AddObject(NormalizedValue, Attr);
    end;

    AS_IDREFS_DATATYPE:
    begin
      // VC: Entity (XML 1.0, § 3.3.1)
      if not IsXmlNames(NormalizedValue) then begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
      
      StartIndex := 1; IndexCount := 0;
      for I := 1 to System.Length(NormalizedValue) do begin
        if NormalizedValue[I] = SPACE then begin
          S := Copy(NormalizedValue, StartIndex, IndexCount);
          FIDREFs.AddObject(S, Attr);
          StartIndex := Succ(I);
          IndexCount := 0;
        end else Inc(IndexCount);
      end;
      S := Copy(NormalizedValue, StartIndex, IndexCount);
      FIDREFs.AddObject(S, Attr);
    end;

    AS_ENTITY_DATATYPE:
    begin
      // VC: Entity Name (XML 1.0, § 3.3.1)
      if IsXMLName(NormalizedValue) then begin
        if not HasUnparsedEntity(NormalizedValue) then begin
          IsValid := False;
          if not SendErrorNotification(ET_UNDEFINED_TARGET_UNPARSED_ENTITY, AttriDecl, Attr) then begin
            AContinue := False;
            Exit;
          end;
        end;
      end else begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
    end;

    AS_ENTITIES_DATATYPE:
    begin
      // VC: Entity Name (XML 1.0, § 3.3.1)
      if IsXmlNames(NormalizedValue) then begin
        StartIndex := 1; IndexCount := 0;
        for I := 1 to System.Length(NormalizedValue) do begin
          if NormalizedValue[I] = SPACE then begin
            if not HasUnparsedEntity(Copy(NormalizedValue, StartIndex, IndexCount)) then begin
              IsValid := False;
              if not SendErrorNotification(ET_UNDEFINED_TARGET_UNPARSED_ENTITY, AttriDecl, Attr) then begin
                AContinue := False;
                Exit;
              end;
            end;
            StartIndex := Succ(I);
            indexCount := 0;
          end else Inc(IndexCount);
        end;
        if not HasUnparsedEntity(Copy(NormalizedValue, StartIndex, IndexCount)) then begin
          IsValid := False;
          if not SendErrorNotification(ET_UNDEFINED_TARGET_UNPARSED_ENTITY, AttriDecl, Attr) then begin
            AContinue := False;
            Exit;
          end;
        end;
      end else begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
    end;

    AS_NMTOKEN_DATATYPE:
    begin
      if IsXmlNmtoken(NormalizedValue) then begin
        // VC: Enumeration (XML 1.0, § 3.3.1)
        if not HasAttrEnum(AttriDecl, NormalizedValue) then begin
          IsValid := False;
          if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
            AContinue := False;
            Exit;
          end;
        end;
      end else begin
        // VC: Name Token (XML 1.0, § 3.3.1)
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
    end;

    AS_NMTOKENS_DATATYPE:
    begin
      // VC: Name Token (XML 1.0, § 3.3.1)
      if not IsXmlNmtokens(NormalizedValue) then begin
        IsValid := False;
        if not SendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH, AttriDecl, Attr) then begin
          AContinue := False;
          Exit;
        end;
      end;
    end;

  end; {case ...}

end;

procedure TDtdValidationAgent.ValidateDTD(out IsValid,
                                              AContinue: Boolean);
// Validates the DTD model.  Each fatal error, error or warning encountered
// is reported via the OnError event of the TDomImplementation component
// associated with the owner document.  OnError events might occur more than
// once, if more than one fatal error, error or warning is encountered.
//
// Return Values:
// - IsValid: Indicates whether the DTD itself is valid or not.
// - AContinue: 'False' to indicate that the validation should be aborted.
//
// Note that not every violation of a validity constraint is being detected,
// since documents using the TDtdValidationAgent object are themselves not
// automatically checked for validity.

  procedure ValidateElementDeclarations(out IsValid, AContinue: Boolean);
  var
    Dummy: Integer;
    ElmtDecl: TDtdElementDecl;
    EnumerationTypes: TUtilsWideStringList;
    I, J: Integer;
  begin
    AContinue := True;
    IsValid := True;
    with DtdModel.ElementDecls do
      for I := 0 to Pred(Length) do begin
        ElmtDecl := TDtdElementDecl(Item(I));
        // VC: No Duplicate Types (XML 1.0, § 3.2.2).
        with ElmtDecl do
          if ContentType = DTD_MIXED_CONTENTTYPE then begin
            if not Assigned(ContentModel) then begin
              IsValid := False;
              if not SendErrorNotification(ET_INVALID_ELEMENT_DECL, ElmtDecl, nil) then begin 
                AContinue := False;
                Exit;
              end;                                                
            end else begin
              with ContentModel do
                if ContentModelType = DTD_CHOICE_CM then begin
                  EnumerationTypes := TUtilsWideStringList.Create;
                  EnumerationTypes.Sorted := True;
                  EnumerationTypes.Duplicates := dupError;
                  try
                    with SubModels do
                      for J := 0 to Pred(Length) do begin
                        if Item(J).ObjectType <> DTD_CONTENT_MODEL then begin
                          IsValid := False;
                          if not SendErrorNotification(ET_INVALID_ELEMENT_DECL, ElmtDecl, nil) then begin
                            AContinue := False;
                            Exit;
                          end;
                        end else begin
                          with TDtdContentModel(Item(J)) do
                          if ContentModelType <> DTD_ELEMENT_CM then begin
                            IsValid := False;
                            if not SendErrorNotification(ET_INVALID_ELEMENT_DECL, ElmtDecl, nil) then begin 
                              AContinue := False;
                              Exit;
                            end;
                          end else begin
                            if EnumerationTypes.Find(Name, Dummy) then begin
                              IsValid := False;
                              if not SendErrorNotification(ET_DUPLICATE_NAME_IN_MIXED_CONTENT, ElmtDecl, nil) then begin
                                AContinue := False;
                                Exit;
                              end;
                            end else EnumerationTypes.Add(Name);
                          end; {if ... else ...}
                        end; {if ... else ...}
                      end; {for J ...}
                  finally
                    EnumerationTypes.Free;
                  end;
                end else begin
                  IsValid := False;
                  if not SendErrorNotification(ET_INVALID_ELEMENT_DECL, ElmtDecl, nil) then begin 
                    AContinue := False;
                    Exit;
                  end;
                end; {if ... else ...}
            end; {if ... else ...}
          end; {if ...}
      end; {for I ...}
  end;

  procedure ValidateEntityDeclarations(out IsValid, AContinue: Boolean);
  var
    I: Integer;
  begin
    AContinue := True;
    IsValid := True;
    with DtdModel.EntityDecls do
      for I := 0 to Pred(Length) do
        with TDtdEntityDecl(Item(I)) do
          // VC: Notation Declared (XML 1.0, § 4.2.2)
          if not IsParsedEntity then
            if not Assigned(FindNotationDecl(NotationName)) then begin
              IsValid := False;
              if not Self.SendErrorNotification(ET_UNDEFINED_NOTATION, TDtdEntityDecl(Item(I)), nil) then begin
                AContinue := False;
                Exit;
              end;
            end;
  end;

  procedure ValidateAttributeDeclarations(const IDNames,
                                                NotationNames: TUtilsWideStringList;
                                            out IsValid, AContinue: Boolean);
  var
    AttrDecl: TDtdAttributeDecl;
    Dummy: Integer;
    AttDeclCol: TDtdAttDeclCollection;
    ElmtDecl: TDtdElementDecl;
    EnumerationTokens: TUtilsWideStringList;
    I, J, K: Integer;
    NormalizationError: TXmlErrorType;
    NormalizedValue: WideString;
    NotationTokens: TUtilsWideStringList;
  begin
    AContinue := True;
    IsValid := True;
    with DtdModel.AttDeclCollections do
      for I := 0 to Pred(Length) do begin
        AttDeclCol := TDtdAttDeclCollection(Item(I));
        with AttDeclCol.AttributeDecls do
          for J := 0 to Pred(Length) do begin
            AttrDecl := TDtdAttributeDecl(Item(J));

            if AttrDecl.ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin
              NormalizeAttrDeclValue(AttrDecl, NormalizedValue, NormalizationError);
              if not (NormalizationError in ET_WARNINGS) then
                IsValid := False;
              if NormalizationError <> ET_NONE then begin
                if not SendErrorNotification(NormalizationError, AttrDecl, nil) then begin
                  AContinue := False;
                  Exit;
                end;
              end;
            end else
              NormalizedValue := '';
            
            with AttrDecl do
              case AttrType of

                AS_ID_DATATYPE:
                begin
                  // VC: One ID per Element Type (XML 1.0, § 3.3.1)
                  if IdNames.Find(AttDeclCol.Name, Dummy) then begin
                    IsValid := False;
                    if not SendErrorNotification(ET_DUPLICATE_ID_ON_ELEMENT_TYPE, AttrDecl, nil) then begin
                      AContinue := False;
                      Exit;
                    end;
                  end else
                    IdNames.Add(AttDeclCol.Name);
                  // VC: ID Attribute Default (XML 1.0, § 3.3.1)
                  if not ( ConstraintType in [AVC_IMPLIED, AVC_REQUIRED] ) then begin
                    IsValid := False;
                    if not SendErrorNotification(ET_ID_NEITHER_IMPLIED_NOR_REQUIRED, AttrDecl, nil) then begin
                      AContinue := False;
                      Exit;
                    end;
                  end;
                end;

                AS_NOTATION_DATATYPE:
                begin
                  NotationTokens := TUtilsWideStringList.Create;
                  NotationTokens.Sorted := True;
                  NotationTokens.Duplicates := dupError;
                  try
                    with Enumeration do begin
                      for K := 0 to Pred(Count) do begin
                        // VC: Notation Attributes (XML 1.0, § 3.3.1)
                        if not Assigned(FindNotationDecl(WideStrings[K])) then begin
                          IsValid := False;
                          if not SendErrorNotification(ET_UNDEFINED_NOTATION, AttrDecl, nil) then begin
                            AContinue := False;
                            Exit;
                          end;
                        end;
                        // VC: No Duplicate Tokens (XML 1.0, § 3.3.1)
                        if NotationTokens.Find(WideStrings[K], Dummy) then begin
                          IsValid := False;
                          if not SendErrorNotification(ET_DUPLICATE_NOTATION_TOKEN, AttrDecl, nil) then begin
                            AContinue := False;
                            Exit;
                          end;
                        end else
                          NotationTokens.Add(WideStrings[K]);
                      end; {for ...}
                    end; {with ...}
                  finally
                    NotationTokens.Free;
                  end;

                  // VC: One Notation per Element Type (XML 1.0, § 3.3.1)
                  if NotationNames.Find(AttDeclCol.Name, Dummy) then begin
                    IsValid := False;
                    if not SendErrorNotification(ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE, AttrDecl, nil) then begin
                      AContinue := False;
                      Exit;
                    end;
                  end else
                    NotationNames.Add(AttDeclCol.Name);

                  // VC: No Notation on Empty Element (XML 1.0, § 3.3.1)
                  ElmtDecl := FindElementDecl(AttDeclCol.Name);
                  if ElmtDecl.ContentType = DTD_EMPTY_CONTENTTYPE then begin
                    IsValid := False;
                    if not SendErrorNotification(ET_NOTATION_ON_EMPTY_ELEMENT, AttrDecl, nil) then begin
                      AContinue := False;
                      Exit;
                    end;
                  end;
                end; {AS_NOTATION_DATATYPE ...}

                AS_IDREF_DATATYPE:
                begin
                  // VC: IDREF (XML 1.0, § 3.3.1)
                  if ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin
                    // VC: Attribute Default Value Syntactically Correct (XML 1.0, § 3.3.2)
                    if not IsXMLName(NormalizedValue) then begin
                      IsValid := False;
                      if not SendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, AttrDecl, nil) then begin
                        AContinue := False;
                        Exit;
                      end;
                    end;
                  end;
                end;

                AS_IDREFS_DATATYPE:
                begin
                  // VC: IDREF (XML 1.0, § 3.3.1)
                  if ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin
                    // VC: Attribute Default Value Syntactically Correct (XML 1.0, § 3.3.2)
                    if not IsXmlNames(NormalizedValue) then begin
                      IsValid := False;
                      if not SendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, AttrDecl, nil) then begin
                        AContinue := False;
                        Exit;
                      end;
                    end;
                  end;
                end;

                AS_ENTITY_DATATYPE:
                begin
                  // VC: Entity Name (XML 1.0, § 3.3.1)
                  if ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin
                    // VC: Attribute Default Value Syntactically Correct (XML 1.0, § 3.3.2)
                    if not IsXMLName(NormalizedValue) then begin
                      IsValid := False;
                      if not SendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, AttrDecl, nil) then begin
                        AContinue := False;
                        Exit;
                      end;
                    end;
                  end;
                end;

                AS_ENTITIES_DATATYPE:
                begin
                  // VC: Entity Name (XML 1.0, § 3.3.1)
                  if ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin
                    // VC: Attribute Default Value Syntactically Correct (XML 1.0, § 3.3.2)
                    if not IsXmlNames(NormalizedValue) then begin
                      IsValid := False;
                      if not SendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, AttrDecl, nil) then begin
                        AContinue := False;
                        Exit;
                      end;
                    end;
                  end;
                end;

                AS_NMTOKEN_DATATYPE:
                begin
                  EnumerationTokens := TUtilsWideStringList.Create;
                  try
                    EnumerationTokens.Sorted := True;
                    EnumerationTokens.Duplicates := dupError;
                    // VC: No Duplicate Tokens (XML 1.0, § 3.3.1)
                    with Enumeration do begin
                      for K := 0 to Pred(Count) do begin
                        if EnumerationTokens.Find(WideStrings[K], Dummy) then begin
                          IsValid := False;
                          if not SendErrorNotification(ET_DUPLICATE_ENUMERATION_TOKEN, AttrDecl, nil) then begin
                            AContinue := False;
                            Exit;
                          end;
                        end else
                          EnumerationTokens.Add(WideStrings[K]);
                      end;
                    end;
                    // VC: Name Token (XML 1.0, § 3.3.1)
                    if ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin
                      // VC: Attribute Default Value Syntactically Correct (XML 1.0, § 3.3.2)
                      if not IsXmlNmtoken(NormalizedValue) then begin
                        IsValid := False;
                        if not SendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, AttrDecl, nil) then begin
                          AContinue := False;
                          Exit;
                        end
                      end;
                      if EnumerationTokens.Count > 0 then
                        if not EnumerationTokens.Find(NormalizedValue, Dummy) then begin
                          IsValid := False;
                          if not SendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, AttrDecl, nil) then begin
                            AContinue := False;
                            Exit;
                          end;
                        end;
                    end;
                  finally
                    EnumerationTokens.Free;
                  end;
                end;

                AS_NMTOKENS_DATATYPE:
                begin
                  // VC: Name Token (XML 1.0, § 3.3.1)
                  if ConstraintType in [AVC_DEFAULT, AVC_FIXED] then begin
                    // VC: Attribute Default Value Syntactically Correct (XML 1.0, § 3.3.2)
                    if not IsXmlNmtokens(NormalizedValue) then begin
                      IsValid := False;
                      if not SendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, AttrDecl, nil) then begin
                        AContinue := False;
                        Exit;
                      end;
                    end;
                  end;
                end;

              end; {case}
        end; {for J ...}
      end; {for I ...}
  end;

var
  IdNames: TUtilsWideStringList;
  NotationNames: TUtilsWideStringList;
  IsValid_2: Boolean;
begin
  // Validiate Element Declarations:
  ValidateElementDeclarations(IsValid, AContinue);
  if not AContinue then Exit;

  // Validiate Entity Declarations:
  ValidateEntityDeclarations(IsValid_2, AContinue);
  IsValid := IsValid and IsValid_2;
  if not AContinue then Exit;

  // Validiate Attribute Declarations:
  IdNames := TUtilsWideStringList.Create;
  IdNames.Sorted := True;
  IdNames.Duplicates := dupError;
  NotationNames := TUtilsWideStringList.Create;
  NotationNames.Sorted := True;
  NotationNames.Duplicates := dupError;
  try
    ValidateAttributeDeclarations(IDNames, NotationNames, IsValid_2, AContinue);
    IsValid := IsValid and IsValid_2;
    if not AContinue then Exit;
  finally
    IDNames.Free;
    NotationNames.Free;
  end;
end;

function TDtdValidationAgent.ValidateDocument(const Opt: TDomEntityResolveOption): Boolean;
var
  Dummy: Integer;
  I: Integer;
  IsValid, AContinue: Boolean;
begin
  Result := True;
  FIDs.Clear;
  FIDREFs.Clear;

  try

    // Build the DTD model:
    if not (DtdModel.PreparationStatus = PS_COMPLETED) then begin
      BuildDtdModel(True);
      Result :=  DtdModel.PreparationStatus <> PS_INCOMPLETE_ABORTED;
    end;

    if DtdModel.PreparationStatus = PS_INEXISTANT then begin
      if not SendErrorNotification(ET_DOCTYPE_NOT_FOUND, nil, OwnerDocument) then
        Exit;
    end else begin
      // Validate the DTD model:
      ValidateDTD(IsValid, AContinue);
      Result := Result and IsValid;
      if not AContinue then
        Exit;
    end;

    if Assigned(OwnerDocument.DocumentElement) then begin

      // VC: Root Element Type (XML 1.0, § 2.8)
      if Assigned(OwnerDocument.DoctypeDecl) then
        if OwnerDocument.DoctypeDecl.Name <> OwnerDocument.DocumentElement.NodeName then begin
          Result := False;
          if not SendErrorNotification(ET_WRONG_ROOT_ELEMENT_TYPE, nil, OwnerDocument.DocumentElement) then
            Exit;
        end;

      // Validate the child nodes:
      ValidateNode(OwnerDocument.DocumentElement, Opt, IsValid, AContinue);
      Result := Result and IsValid;
      if not AContinue then
        Exit;

      // VC: IDREF (XML 1.0, § 3.3.1)
      for I := 0 to Pred(FIDREFs.Count) do
        if not FIDs.Find(FIDREFs[I], Dummy) then begin
          Result := False;
          if not SendErrorNotification(ET_TARGET_ID_VALUE_NOT_FOUND, nil, FIDREFs.Objects[I] as TDomAttr) then
            Exit;
        end;

    end else begin
      Result := False;
      if not SendErrorNotification(ET_ROOT_ELEMENT_NOT_FOUND, nil, OwnerDocument) then
        Exit;
    end;

  finally
    if not Result then begin
      FIDs.Clear;
      FIDREFs.Clear;
    end;
  end;
end;

procedure TDtdValidationAgent.ValidateElement(const Elmt: TDomElement;
                                              const Opt: TDomEntityResolveOption;
                                                out IsValid,
                                                    AContinue: Boolean);
// Return Values:
// - IsValid: Indicates whether the element is valid according to some tests
//            made in this subroutine.
// - AContinue: 'False' to indicate that the validation should be aborted.

  procedure ResolveEntityReferences(const Elmt: TDomElement;
                                    const Opt: TDomEntityResolveOption;
                                      out IsValid,
                                          AContinue: Boolean);
  var
    Dummy1: Boolean;
    Dummy2: Int64;
    Error: TXmlErrorType;
    I: Integer;
    HasEntRefs: Boolean;
    Child: TDomNode;
    DocFrag: TDomDocumentFragment;
    ReplacementText: WideString;
  begin
    AContinue := True;
    IsValid := True;
    case Opt of

      erReplace:
      begin
        HasEntRefs := False;
        I := 0;
        while I < Elmt.ChildNodes.Length do begin
          Child := Elmt.ChildNodes.Item(I);
          if Child.NodeType = ntEntity_Reference_Node then begin
            HasEntRefs := True;

            Error := FindEntityReplacementText(Child.NodeName, ReplacementText, Dummy1, Dummy2);
            if Error <> ET_NONE then begin
              if not (Error in ET_WARNINGS) then
                IsValid := False;
              if not SendErrorNotification(Error, nil, Child) then begin
                AContinue := False;
                Exit;
              end;
            end;

            try
              DocFrag := ParseWideString(ReplacementText);
              try
                Elmt.ReplaceChild(DocFrag, Child);
                Child.Free;
                Dec(I); // Necessary, if an empty entity was referenced.
              finally
                DocFrag.Free;
              end;
            except
              Error := ET_NO_PROPER_MARKUP_REFERENCED; 
              IsValid := False;
              if not SendErrorNotification(Error, nil, Child) then begin
                AContinue := False;
                Exit;
              end;
            end;

          end;
          Inc(I);
        end; {while ...}
        if HasEntRefs then
          Elmt.Normalize;
      end;

      erExpand:
      begin
        for I := 0 to Pred(Elmt.ChildNodes.Length) do begin
          Child := Elmt.ChildNodes.Item(I);
          if Child.NodeType = ntEntity_Reference_Node then begin
            Error := ExpandEntityReference(Child as TDomEntityReference);
            if Error <> ET_NONE then begin
              if not (Error in ET_WARNINGS) then
                IsValid := False;
              if not SendErrorNotification(Error, nil, Child) then begin
                AContinue := False;
                Exit;
              end;
            end;
          end;
        end; {for ...}
      end;

    end;
  end;

var
  ElementNames: TUtilsWideStringList;
  ElmDecl: TDtdElementDecl;
  I, Index: Integer;
  IsNonDeterministic: Boolean;
  NodeToTest: TDomNode;
  Dummy, IsValid_2, Ok: Boolean;
  TreeWalker: TDomTreeWalker;
begin
  Assert(Assigned(Elmt));
  AContinue := True;
  IsValid := True;

  // VC: Element Valid (XML 1.0, § 3)
  ElmDecl := FindElementDecl(Elmt.NodeName);
  if not Assigned(ElmDecl) then begin
    IsValid := False;
    if not SendErrorNotification(ET_UNDEFINED_ELEMENT_TYPE, nil, Elmt) then begin
      AContinue := False;
      Exit;
    end;
    ResolveEntityReferences(Elmt, Opt, Dummy, Dummy);
    Exit;  // Exit, because ElmDecl is unassigned.
  end;

  case ElmDecl.ContentType of

    DTD_ANY_CONTENTTYPE:
      ResolveEntityReferences(Elmt, Opt, IsValid, AContinue);

    DTD_EMPTY_CONTENTTYPE:
    begin
      for I := 0 to Pred(Elmt.ChildNodes.Length) do begin
        NodeToTest := Elmt.ChildNodes.Item(I);
        if not ( (NodeToTest.NodeType = ntText_Node) and (NodeToTest.NodeValue = '') ) then begin
          IsValid := False;
          if not SendErrorNotification(ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT, ElmDecl, Elmt) then begin
            AContinue := False;
            Exit;
          end;
        end;
      end;
      ResolveEntityReferences(Elmt, Opt, IsValid_2, AContinue);
      IsValid := IsValid and IsValid_2;
    end;

    DTD_ELEMENT_CONTENTTYPE:
    begin

      ResolveEntityReferences(Elmt, Opt, IsValid, AContinue);
      if not AContinue then
        Exit;

      ElementNames := TUtilsWideStringList.Create;
      try

        TreeWalker := Elmt.OwnerDocument.CreateTreeWalker( Elmt,
                        [ ntElement_Node, ntText_Node, ntCDATA_Section_Node ],
                        nil, True );
        try
          NodeToTest := TreeWalker.FirstChild;
          while Assigned(NodeToTest) do begin
            with NodeToTest do begin
              case NodeType of
                ntElement_Node:
                  Elementnames.Add(NodeName);
                ntText_Node:
                  if not (NodeToTest as TDomText).IsElementContentWhitespace then begin
                    IsValid := False;
                    AContinue := SendErrorNotification(ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_PCDATA_WHERE_ELEMENT_ONLY, ElmDecl, Elmt);
                    Exit;
                  end else begin

                    // VC: Standalone Document Declaration (XML 1.0, § 2.9)
                    if ElmDecl.Origin = DTD_EXTERNALLY_DECLARED then
                      if DocumentIsStandalone then begin
                        IsValid := False;
                        AContinue := SendErrorNotification(ET_WHITESPACE_IN_EXT_ELEMENT_CONTENT_IN_STANDALONE_DOC, ElmDecl, Elmt);
                        Exit;
                      end;

                  end;
                ntCDATA_Section_Node:
                  begin
                    IsValid := False;
                    AContinue := SendErrorNotification(ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_CDATA_SECTION_WHERE_ELEMENT_ONLY, ElmDecl, Elmt);
                    Exit;
                  end;
              end; {case ...}
            end; {with ...}
            NodeToTest := TreeWalker.NextSibling;
          end; {while ...}
        finally
          Elmt.OwnerDocument.FreeTreeWalker(TreeWalker);
        end; {try ...}

        if not Assigned(ElmDecl.ContentModel) then
          raise EParserException.Create('Internal Parser error.');
        Index := 0;
        Ok := ElmDecl.ContentModel.ValidateNames(Elementnames, Index, IsNonDeterministic);
        if IsNonDeterministic then begin
          IsValid := False;
          AContinue := SendErrorNotification(ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL, ElmDecl, Elmt);
        end else if not (Ok and (Index = Elementnames.Count)) then begin
          IsValid := False;
          AContinue := SendErrorNotification(ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_CHILD_ELEMENT_TYPE, ElmDecl, Elmt);
        end;

      finally
        Elementnames.Free;
      end;
    end;

    DTD_MIXED_CONTENTTYPE:
    begin

      ResolveEntityReferences(Elmt, Opt, IsValid, AContinue);
      if not AContinue then
        Exit;

      Elementnames := TUtilsWideStringList.Create;
      try

        TreeWalker := Elmt.OwnerDocument.CreateTreeWalker( Elmt, [ ntElement_Node ], nil, True );
        try
          NodeToTest := TreeWalker.FirstChild;
          while Assigned(NodeToTest) do begin
             Elementnames.Add(NodeToTest.NodeName);
            NodeToTest := TreeWalker.NextSibling;
          end;
        finally
          Elmt.OwnerDocument.FreeTreeWalker(TreeWalker);
        end; {try ...}

        if not Assigned(ElmDecl.ContentModel) then
          raise EParserException.Create('Internal Parser error.');
        if (ElmDecl.ContentModel.ContentModelType = DTD_CHOICE_CM) and
           (ElmDecl.ContentModel.SubModels.Length = 0) then begin  // Is PCDATA only?
          if Elementnames.Count > 0 then begin
            IsValid := False;
            AContinue := SendErrorNotification(ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_ELEMENT_WHERE_PCDATA_ONLY, ElmDecl, Elmt);
          end;
        end else begin
          Index := 0;
          Ok := ElmDecl.ContentModel.ValidateNames(Elementnames, Index, IsNonDeterministic);
          if IsNonDeterministic then begin
            IsValid := False;
            AContinue := SendErrorNotification(ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL, ElmDecl, Elmt);
          end else if not (Ok and (Index = Elementnames.Count)) then begin
            IsValid := False;
            AContinue := SendErrorNotification(ET_ELEMENT_CONTENT_MODEL_MISMATCH_WITH_CHILD_ELEMENT_TYPE, ElmDecl, Elmt);
          end;
        end; {if ... else ...}

      finally
        Elementnames.Free;
      end;
    end;

    DTD_STRICT_MIXED_CONTENTTYPE:
      raise EParserException.Create('DTD_STRICT_MIXED_CONTENTTYPE not supported in TDtdValidationAgent.');

  end; {case ...}
end;

procedure TDtdValidationAgent.ValidateEntityRef(const EntRef: TDomEntityReference;
                                                  out IsValid,
                                                      AContinue: Boolean);
// Return Values:
// - IsValid: Indicates whether the element is valid according to some tests
//            made in this subroutine.
// - AContinue: 'False' to indicate that the validation should be aborted.
var
  EntDecl: TDtdEntityDecl;
  Error: TXmlErrorType;
begin
  Assert(Assigned(OwnerDocument));

  AContinue := True;
  EntDecl := FindEntityDecl(EntRef.NodeName);

  if Assigned(EntDecl) then begin

    IsValid := True;

    Error := EntDecl.ResolveReplacementText(ResolveEntity);
    if not (Error = ET_NONE) then begin
      if not (Error in ET_WARNINGS) then
        IsValid := False;
      if not SendErrorNotification(Error, EntDecl, EntRef) then begin
        AContinue := False;
        Exit;
      end;
    end;

    if not EntDecl.CheckNoRecursion then begin
      // WFC: No Recursion (XML 1.0, § 4.1)
      IsValid := False;
      if not SendErrorNotification(ET_RECURSIVE_REFERENCE, EntDecl, EntRef) then begin
        AContinue := False;
        Exit;
      end;
    end;

    if EntDecl.Origin = DTD_EXTERNALLY_DECLARED then begin
      if DocumentIsStandalone then begin
        // WFC: Entity declared (XML 1.0, § 4.1)
        IsValid := False;
        if not SendErrorNotification(ET_EXT_DECL_ENTITY_REFERENCED_IN_STANDALONE_DOC, EntDecl, EntRef) then begin
          AContinue := False;
          Exit;
        end;
      end;
    end;

  end else begin

    IsValid := False;

    if DocumentIsStandalone then begin
      // WFC: Entity declared (XML 1.0, § 4.1)
      if not SendErrorNotification(ET_UNDEFINED_ENTITY_WFC, nil, EntRef) then begin
        AContinue := False;
        Exit;
      end;
    end else begin
      // VC: Entity declared (XML 1.0, § 4.1)
      if not SendErrorNotification(ET_UNDEFINED_ENTITY_VC, nil, EntRef) then begin
        AContinue := False;
        Exit;
      end;
    end;

  end;

end;

procedure TDtdValidationAgent.ValidateNode(const Node: TDomNode;
                                           const Opt: TDomEntityResolveOption;
                                             out IsValid,
                                                 AContinue: Boolean);
var
  I: Integer;
  IsValid_2: Boolean;
begin
  AContinue := True;
  IsValid := True;

  if Node is TDomElement then begin
    // Update and validate default and fixed attributes:
    AddAndValidateDefaultAttributes(TDomElement(Node), IsValid, AContinue);
    if not AContinue then
      Exit;

    // Validate the element content model:
    ValidateElement(TDomElement(Node), Opt, IsValid_2, AContinue);
    IsValid := IsValid and IsValid_2;
    if not AContinue then
      Exit;

    // Validate attributes:
    for I := 0 to Pred(Node.Attributes.Length) do begin
      ValidateNode(Node.Attributes.Item(I), Opt, IsValid_2, AContinue);
      IsValid := IsValid and IsValid_2;
      if not AContinue then
        Exit;
    end;

    // Validate child nodes:
    for I := 0 to Pred(Node.Childnodes.Length) do begin
      ValidateNode(Node.Childnodes.Item(I), Opt, IsValid_2, AContinue);
      IsValid := IsValid and IsValid_2;
      if not AContinue then
        Exit;
    end;

  end else if Node is TDomAttr then begin
    ValidateAttr(TDomAttr(Node), Opt, IsValid, AContinue);
    if not AContinue then
      Exit;

  end else if Node is TDomEntityReference then begin
    ValidateEntityRef(TDomEntityReference(Node), IsValid, AContinue);
    if not AContinue then
      Exit;
    // Validate child nodes:
    for I := 0 to Pred(Node.Childnodes.Length) do begin
      ValidateNode(Node.Childnodes.Item(I), Opt, IsValid_2, AContinue);
      IsValid := IsValid and IsValid_2;
      if not AContinue then
        Exit;
    end;

  end;
end;



//+++++++++++++++++++++++++++ TDtdObject +++++++++++++++++++++++++++++++
constructor TDtdObject.Create(const AOwner: TDtdModel;
                                const AName: WideString);
begin
  if not Assigned(AOwner) then
    raise EAccessViolation.Create('Owner DTD subset model not specified.');

  inherited Create;

  FObjectType := DTD_UNDEFINED;
  FOwnerModel := AOwner;
  FName := AName;
  FKey := AOwner.GetNewKey;
end;

function TDtdObject.GetName: WideString;
begin
  Result := FName;
end;



//+++++++++++++++++++++++++++ TDtdContentModel +++++++++++++++++++++++++++
constructor TDtdContentModel.Create(const AOwnerElementDecl: TDtdElementDecl;
                                      const AName: WideString;
                                      const AContentModelType: TDtdContentModelType);
begin
  if AContentModelType = DTD_ELEMENT_CM
    then inherited Create(AOwnerElementDecl.OwnerModel, AName)
    else inherited Create(AOwnerElementDecl.OwnerModel, '');

  case AContentModelType of
    DTD_ELEMENT_CM:
      FAllowedChildTypes := [];
    DTD_CHOICE_CM, DTD_SEQUENCE_CM:
      FAllowedChildTypes := [ DTD_ELEMENT_CM,
                              DTD_CHOICE_CM,
                              DTD_SEQUENCE_CM ];
  end;

  FContentModelType := AContentModelType;
  FFrequency := DTD_REQUIRED_FRQ;
  FInuse := False;
  FObjectType := DTD_CONTENT_MODEL;
  FOwnerElementDecl := AOwnerElementDecl;
  FSubModels := TDtdObjectList.Create;
end;

destructor TDtdContentModel.Destroy;
begin
  FSubModels.Free;
  inherited;
end;

function TDtdContentModel.AppendSubModel(const NewCM: TDtdContentModel): TDtdContentModel;
begin
  if NewCM.FInuse then
    raise EInuse_Err.Create('Content model in use error.');
  Result := (FSubModels.AppendNode(NewCM) as TDtdContentModel);
  NewCM.FInuse:= True;
end;

function TDtdContentModel.InsertBeforeSubModel(const NewCM,
                                                       RefCM: TDtdContentModel): TDtdContentModel;
begin
  if NewCM.FInuse then
    raise EInuse_Err.Create('Content model in use error.');
  Result := (FSubModels.InsertBefore(NewCM, RefCM) as TDtdContentModel);
  NewCM.FInuse:= True;
end;

function TDtdContentModel.RemoveSubModel(const OldCM: TDtdContentModel): TDtdContentModel;
begin
  if FSubModels.indexof(OldCM) = -1 then
    raise ENot_Found_Err.Create('Node not found error.');
  Result := (FSubModels.RemoveNode(OldCM) as TDtdContentModel);
  OldCM.FInuse:= False;
end;

function TDtdContentModel.ValidateChoiceNames(const Source: TUtilsWideStringList;
                                                  var Index: Integer;
                                                      Freq: TDtdFrequency;
                                                  out IsNonDeterministic: Boolean): Boolean;
var
  I: Integer;
  Matched: Boolean;
  MatchNumber: Integer;
  RestIndex, TempIndex: Integer;
begin
  IsNonDeterministic:= False;
  Result := False;

  RestIndex := Index;
  Matched := False;
  MatchNumber := 0;
  for I := 0 to Pred(SubModels.Length) do begin
    TempIndex := Index;
    if (SubModels.Item(I) as TDtdContentModel).ValidateNames(Source, TempIndex, IsNonDeterministic) then begin
      Matched := True;
      if Index <> TempIndex then begin // Do not count matching empty expressions
        Inc(MatchNumber);
        if MatchNumber > 1 then begin
          IsNonDeterministic := True;
          Break;
        end;
        RestIndex := TempIndex;
      end;
    end else if IsNonDeterministic then Break;
  end;

  case Freq of

    DTD_REQUIRED_FRQ:
    begin
      if Matched then begin
        Index := RestIndex;
        Result := True;
      end else Result := False;
    end;

    DTD_OPTIONAL_FRQ:
    begin
      if Matched then Index := RestIndex;
      Result := True;
    end;

  end; {case ...}

  if IsNonDeterministic then Result := False;
end;

function TDtdContentModel.ValidateElementNames(const Source: TUtilsWideStringList;
                                                   var Index: Integer;
                                                       Freq: TDtdFrequency;
                                                   out IsNonDeterministic: Boolean): Boolean;
begin
  IsNonDeterministic:= False;
  Result := False;

  case Freq of

    DTD_REQUIRED_FRQ:
    begin
      if Index = Source.Count then Exit;
      if Source[Index] = Name then begin
        Inc(Index);
        Result := True;
      end else Result := False;
    end;

    DTD_OPTIONAL_FRQ:
    begin
      Result := True;
      if Index = Source.Count then Exit;
      if Source[Index] = Name then Inc(Index);
    end;

  end; {case ...}
end;

function TDtdContentModel.ValidateNames2(const Source: TUtilsWideStringList;
                                             var Index: Integer;
                                                 Freq: TDtdFrequency;
                                             out IsNonDeterministic: Boolean): Boolean;
begin
  case ContentModelType of
    DTD_CHOICE_CM:   Result := ValidateChoiceNames(Source, Index, Freq, IsNonDeterministic);
    DTD_ELEMENT_CM:  Result := ValidateElementNames(Source, Index, Freq, IsNonDeterministic);
    DTD_SEQUENCE_CM: Result := ValidateSequenceNames(Source, Index, Freq, IsNonDeterministic);
  else
    Result := True;
  end;
end;

function TDtdContentModel.ValidateNames(const Source: TUtilsWideStringList;
                                            var Index: Integer;
                                            out IsNonDeterministic: Boolean): Boolean;
// Validates a sequence of names contained in the 'Source' list, starting at
// the 'Index' position against the content model.  If successful, 'Index'
// returns the position of the first name of the 'Source' list which remains
// after applying the content model to the names of the list.
var
  TempIndex: Integer; 
begin
  Result := False;
  IsNonDeterministic:= False;
  case Frequency of

    DTD_REQUIRED_FRQ:
      Result := ValidateNames2(Source, Index, DTD_REQUIRED_FRQ, IsNonDeterministic);

    DTD_OPTIONAL_FRQ:
    Result := ValidateNames2(Source, Index, DTD_OPTIONAL_FRQ, IsNonDeterministic);

    DTD_ONE_OR_MORE_FRQ:
    begin
      Result := ValidateNames2(Source, Index, DTD_REQUIRED_FRQ, IsNonDeterministic);
      if Result then begin
        TempIndex := Index;
        while TempIndex < Source.Count do begin
          if not ValidateNames2(Source, TempIndex, DTD_REQUIRED_FRQ, IsNonDeterministic) then Break;
          if Index = TempIndex then Break; // Check for expressions of the form: (foo*)+
          Index := TempIndex;
        end;
      end;
    end;

    DTD_ZERO_OR_MORE_FRQ:
    begin
      Result := ValidateNames2(Source, Index, DTD_OPTIONAL_FRQ, IsNonDeterministic);
      if Result then begin
        TempIndex := Index;
        while TempIndex < Source.Count do begin
          if not ValidateNames2(Source, TempIndex, DTD_REQUIRED_FRQ, IsNonDeterministic) then Break;
          if Index = TempIndex then Break; // Check for expressions of the form: (foo*)* or (foo+)*
          Index := TempIndex;
        end;
      end;
    end;

  end; {case ...}

  if IsNonDeterministic then
    Result := False;
end;

function TDtdContentModel.ValidateSequenceNames(const Source: TUtilsWideStringList;
                                                    var Index: Integer;
                                                        Freq: TDtdFrequency;
                                                    out IsNonDeterministic: Boolean): Boolean;
var
  I: Integer;
  Ok: Boolean;
  Tempindex: Integer;
begin
  IsNonDeterministic := False;
  Result := False;
  Tempindex := Index;

  Ok := False;
  for I := 0 to Pred(SubModels.Length) do begin
    Ok := (SubModels.Item(I) as TDtdContentModel).ValidateNames(Source, Tempindex, IsNonDeterministic);
    if not Ok then Break;
  end;

  case Freq of

    DTD_REQUIRED_FRQ:
    begin
      if Ok then begin
        Index := Tempindex;
        Result := True;
      end else Result := False;
    end;

    DTD_OPTIONAL_FRQ:
    begin
      if Ok then Index := Tempindex;
      Result := True;
    end;

  end; {case ...}

  if IsNonDeterministic then
    Result := False;
end;



// ++++++++++++++++++++++++++ TDtdAttDeclCollection ++++++++++++++++++++++++++
constructor TDtdAttDeclCollection.Create(const AOwner: TDtdModel;
                                           const AName: WideString);
begin
  if not IsXmlName(AName) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner, AName);

  FObjectType := DTD_ATTLIST_DECLARATION;
  FAttributeDeclarations := TDtdNamedObjectMap.Create(AOwner);
end;

destructor TDtdAttDeclCollection.Destroy;
begin
  Clear;
  FAttributeDeclarations.Free;

  inherited;
end;

procedure TDtdAttDeclCollection.Clear;
var
  I: Integer;
begin
  for I := 0 to Pred(FAttributeDeclarations.Length) do
    TDtdAttributeDecl(FAttributeDeclarations.Item(I)).Free;
  FAttributeDeclarations.Clear;
end;

function TDtdAttDeclCollection.FindAttributeDecl(const Name: WideString): TDtdAttributeDecl;
begin
  Result := (FAttributeDeclarations.GetNamedItem(Name) as TDtdAttributeDecl);
end;

function TDtdAttDeclCollection.RemoveAttributeDecl(const Name: WideString): Boolean;
var
  Obj: TDtdObject;
begin
  Obj := FAttributeDeclarations.GetNamedItem(Name);
  if Assigned(Obj) then begin
    FAttributeDeclarations.RemoveNamedItem(Name);
    Obj.Free;
    Result := True;
  end else Result := False;
end;

function TDtdAttDeclCollection.SetAttributeDecl(const AAttrName,
                                                        AAttrValue: WideString;
                                                  const AEnumeration: TUtilsWideStringList;
                                                  const AAttrType: TXmlDataType;
                                                  const AConstraintType: TDomAttrValueConstraint;
                                                  const AOrigin: TDtdOrigin;
                                                    out AttributeDecl: TDtdAttributeDecl): Boolean;
begin
  AttributeDecl := FindAttributeDecl(AAttrName);
  if Assigned(AttributeDecl) then begin
    Result := False;
  end else begin
    AttributeDecl := TDtdAttributeDecl.Create(Self, AAttrName, AAttrValue,
                       AEnumeration, AAttrType, AConstraintType, AOrigin);
    FAttributeDeclarations.SetNamedItem(AttributeDecl);
    Result := True;
  end;
end;



//+++++++++++++++++++++++++ TDtdAttributeDecl ++++++++++++++++++++++++++
constructor TDtdAttributeDecl.Create(const AOwnerCollection: TDtdAttDeclCollection;
                                       const AAttrName,
                                             aDefaultValue: WideString;
                                       const AEnumeration: TUtilsWideStringList;
                                       const AAttrType: TXmlDataType;
                                       const AConstraintType: TDomAttrValueConstraint;
                                       const AOrigin: TDtdOrigin);
begin
  if not IsXmlName(AAttrName) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwnerCollection.OwnerModel, AAttrName);

  FObjectType := DTD_ATTRIBUTE_DECLARATION;
  FAttrType := AAttrType;
  FDefaultValue := ADefaultValue;
  FConstraintType := AConstraintType;
  FOwnerCollection := AOwnerCollection;
  FEnumeration := TUtilsWideStringList.Create;
  FEnumeration.Assign(AEnumeration);
  FOrigin := AOrigin;
end;

destructor TDtdAttributeDecl.Destroy;
begin
  FEnumeration.Free;
  inherited;
end;



//+++++++++++++++++++++++++++ TDtdEntityDecl +++++++++++++++++++++++++++
constructor TDtdEntityDecl.Create(const AOwner: TDtdModel;
                                    const AName,
                                          AReplacementText,
                                          APublicId,
                                          ASystemId,
                                          ANotationName,
                                          ABaseUri: WideString;
                                    const AOrigin: TDtdOrigin);
begin
  if not IsXmlName(AName) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner, AName);

  FObjectType := DTD_ENTITY_DECLARATION;
  FPublicId := APublicId;
  FSystemId := ASystemId;
  FNotationName := ANotationName;
  FBaseUri := ABaseUri;

  FEntityRefs := TUtilsWideStringList.Create;
  FEntityRefs.Duplicates := dupIgnore;

  if EntityType = DTD_INTERNAL_ENTITY then begin
    SetReplacementText(AReplacementText);
  end else if EntityType = DTD_EXTERNAL_ENTITY then begin
    FReplacementText := '';
    FIsResolved := False;
  end else begin
    // Predefined Entity:
    FReplacementText := AReplacementText;
    FIsResolved := True;
  end;

  FOrigin := AOrigin;
end;

destructor TDtdEntityDecl.Destroy;
begin
  FEntityRefs.Free;
  inherited;
end;

function TDtdEntityDecl.CheckNoRecursion: Boolean;
begin
  Result := CheckNoRecursion_2(nil);
end;

function TDtdEntityDecl.CheckNoRecursion_2(const AncestorEntities: TUtilsWideStringList): Boolean;
var
  I: Integer;
  DereferencedEntityDecl: TDtdEntityDecl;
  AncestorEntitiesNew: TUtilsWideStringList;
begin
  Assert(Assigned(OwnerModel));
  Result := True;
  if EntityRefs.Count > 0 then begin
    AncestorEntitiesNew := TUtilsWideStringList.Create;
    try
      if Assigned(AncestorEntities) then
        AncestorEntitiesNew.Assign(AncestorEntities);
      AncestorEntitiesNew.Add(Name);
      with EntityRefs do begin
        // Check current entity:
        for I := 0 to Pred(Count) do begin
          if AncestorEntitiesNew.IndexOf(WideStrings[I]) <> -1 then begin
            Result := False;  // Circular reference found.
            Exit;
          end;
          DereferencedEntityDecl := OwnerModel.FindEntityDecl(WideStrings[I]);
          if Assigned(DereferencedEntityDecl) then
            if not DereferencedEntityDecl.CheckNoRecursion_2(AncestorEntitiesNew) then begin
              Result := False;  // Circular reference found.
              Exit;
            end;
        end;
      end;
    finally
      AncestorEntitiesNew.Free;
    end;
  end;
end;

function TDtdEntityDecl.GetEntityType: TDtdEntityType;
begin
  if (FPublicId = '') and (FSystemId = '') and (FNotationName = '') then begin
    if IsXmlPredefinedEntityName(Name)
      then Result := DTD_PREDEFINED_ENTITY
      else Result := DTD_INTERNAL_ENTITY;
  end else Result := DTD_EXTERNAL_ENTITY;
end;

function TDtdEntityDecl.GetIsParsedEntity: Boolean;
begin
  Result := FNotationName = '';
end;

function TDtdEntityDecl.ResolveReplacementText(const ResolveEntityProc: TDomResolveEntityProc): TXmlErrorType;
var
  S: WideString;
begin
  Result := ET_NONE;
  if (EntityType = DTD_EXTERNAL_ENTITY) and not IsResolved then
    if IsParsedEntity then begin
      ResolveEntityProc(Origin, BaseUri, PublicId, SystemId, S, Result);
      if Result in ET_WARNINGS then
        SetReplacementText(S);
    end else
      // WFC: Parsed Entity (XML 1.0, § 4.1)
      Result := ET_REFERS_TO_UNPARSED_ENTITY;
end;

procedure TDtdEntityDecl.SetReplacementText(const S: WideString);
var
  Tokenizer: TXmlAttrValueTokenizer;
begin
  FReplacementText := S;
  FIsResolved := True;

  // Build FEntityRefs list:
  FEntityRefs.Clear;
  Tokenizer := TXmlAttrValueTokenizer.Create(S);
  try
    with Tokenizer do
      while not (TokenType = ATTR_END_OF_SOURCE_TOKEN) do begin
        Next;
        if TokenType = ATTR_ENTITY_REF then
          FEntityRefs.Add(TokenValue);
      end;
  finally
    Tokenizer.Free;
  end;
end;



//++++++++++++++++++++++++++ TDtdNotationDecl ++++++++++++++++++++++++++
constructor TDtdNotationDecl.Create(const AOwner: TDtdModel;
                                      const AName,
                                            APublicId,
                                            ASystemId: WideString;
                                      const AOrigin: TDtdOrigin);
begin
  if not IsXmlName(AName)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  if not IsXmlPubidChars(APublicId)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  if not IsXmlSystemChars(ASystemId)
    then raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner, AName);
  FObjectType := DTD_NOTATION_DECLARATION;
  FPublicId:= APublicId;
  FSystemId:= ASystemId;
  FOrigin := AOrigin;
end;



//++++++++++++++++++++++++++ TDtdElementDecl +++++++++++++++++++++++++++
constructor TDtdElementDecl.Create(const AOwner: TDtdModel;
                                     const AName: WideString;
                                     const AContentType: TDtdContentType;
                                     const AOrigin: TDtdOrigin);
begin
  if not IsXmlName(AName) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(AOwner, AName);

  FContentType := AContentType;
  case FContentType of
    DTD_ANY_CONTENTTYPE,
    DTD_EMPTY_CONTENTTYPE: FAllowedChildTypes:= [];
    DTD_ELEMENT_CONTENTTYPE,
    DTD_MIXED_CONTENTTYPE,
    DTD_STRICT_MIXED_CONTENTTYPE: FAllowedChildTypes:= [DTD_CHOICE_CM, DTD_SEQUENCE_CM];
  end;

  FCreatedContentModels := TDtdObjectList.Create;
  FObjectType := DTD_ELEMENT_DECLARATION;
  FOrigin := AOrigin;
end;

destructor TDtdElementDecl.Destroy;
begin
  Clear;
  FCreatedContentModels.Free;
  inherited;
end;

procedure TDtdElementDecl.Clear;
var
  I: Integer;
begin
  for I := 0 to Pred(FCreatedContentModels.Length) do
    TDtdContentModel(FCreatedContentModels.Item(I)).Free;
  FCreatedContentModels.Clear;
  FContentModel := nil;
end;

function TDtdElementDecl.CreateContentModel(const Name: WideString;
                                              const ContentModelType: TDtdContentModelType): TDtdContentModel;
begin
  Result := TDtdContentModel.Create(Self, Name, ContentModelType);
  FCreatedContentModels.AppendNode(Result);
end;

procedure TDtdElementDecl.FreeAndNilContentModel(var CM: TDtdContentModel);
var
  SubModel: TDtdContentModel;
begin
  if CM.FInuse then
    raise EInuse_Err.Create('Content model in use error.');
  // First recursively free the submodels:
  with CM do
    with SubModels do
      while Length > 0 do begin
        SubModel := RemoveSubModel(Item(Pred(Length)) as TDtdContentModel);
        FreeAndNilContentModel(SubModel);
      end;
  // Now free the content model:
  FCreatedContentModels.RemoveNode(CM);
  CM.Free;
  CM := nil;
end;

function TDtdElementDecl.ReplaceContentModel(const NewContentModel: TDtdContentModel): TDtdContentModel;
begin
  if FContentModel = NewContentModel then begin
    Result := NewContentModel;
    Exit;
  end;
  if Assigned(NewContentModel) then begin
    if NewContentModel.OwnerModel <> OwnerModel then
      raise ENot_Supported_Err.Create('Not supported error: Wrong owner element declaration.');
    if not (NewContentModel.ContentModelType in FAllowedChildTypes) then
      raise ENot_Supported_Err.Create('Not supported error.');
    if NewContentModel.FInuse then
      raise EInuse_Err.Create('Content model in use error.');
    NewContentModel.FInuse := True;
  end;
  if Assigned(FContentModel)
    then FContentModel.FInuse:= False;
  Result := FContentModel;
  FContentModel := NewContentModel;
end;



//++++++++++++++++++++++++++++++++ TDtdModel ++++++++++++++++++++++++++++++++
constructor TDtdModel.Create;
begin
  inherited Create;

  FLastKey := 0;
  FAttDeclCollections   := TDtdNamedObjectMap.Create(Self);
  FElementDeclarations  := TDtdNamedObjectMap.Create(Self);
  FEntityDeclarations   := TDtdNamedObjectMap.Create(Self);
  FNotationDeclarations := TDtdNamedObjectMap.Create(Self);

  SetDefaults;
end;

destructor TDtdModel.Destroy;
begin
  ClearMaps;
  FAttDeclCollections.Free;
  FElementDeclarations.Free;
  FEntityDeclarations.Free;
  FNotationDeclarations.Free;
  inherited;
end;

procedure TDtdModel.Clear;
begin
  ClearMaps;
  SetDefaults;
end;

procedure TDtdModel.ClearMaps;
var
  I: Integer;
begin
  for I := 0 to Pred(FAttDeclCollections.Length) do
    TDtdAttDeclCollection(FAttDeclCollections.Item(I)).Free;
  FAttDeclCollections.Clear;
  for I := 0 to Pred(FElementDeclarations.Length) do
    TDtdElementDecl(FElementDeclarations.Item(I)).Free;
  FElementDeclarations.Clear;
  for I := 0 to Pred(FEntityDeclarations.Length) do
    TDtdEntityDecl(FEntityDeclarations.Item(I)).Free;
  FEntityDeclarations.Clear;
  for I := 0 to Pred(FNotationDeclarations.Length) do
    TDtdNotationDecl(FNotationDeclarations.Item(I)).Free;
  FNotationDeclarations.Clear;
end;

function TDtdModel.FindAttDeclCollection(const Name: WideString): TDtdAttDeclCollection;
begin
  Result := (FAttDeclCollections.GetNamedItem(Name) as TDtdAttDeclCollection);
end;

function TDtdModel.FindAttributeDecl(const ElementName,
                                           AttributeName: WideString): TDtdAttributeDecl;
var
  AttDeclCol: TDtdAttDeclCollection;
begin
  AttDeclCol := FindAttDeclCollection(ElementName);
  if Assigned(AttDeclCol)
    then Result := AttDeclCol.FindAttributeDecl(AttributeName)
    else Result := nil;
end;

function TDtdModel.FindElementDecl(const Name: WideString): TDtdElementDecl;
begin
  Result := (FElementDeclarations.GetNamedItem(Name) as TDtdElementDecl);
end;

function TDtdModel.FindEntityDecl(const Name: WideString): TDtdEntityDecl;
begin
  Result := (FEntityDeclarations.GetNamedItem(Name) as TDtdEntityDecl);
end;

function TDtdModel.FindNotationDecl(const Name: WideString): TDtdNotationDecl;
begin
  Result := (FNotationDeclarations.GetNamedItem(Name) as TDtdNotationDecl);
end;

function TDtdModel.GetNewKey: Int64;
begin
  Inc(FLastKey);
  Result := FLastKey;
end;

function TDtdModel.RemoveAttributeDecl(const ElementName,
                                             AttributeName: WideString): Boolean;
var
  AttDeclCol: TDtdAttDeclCollection;
begin
  AttDeclCol := FindAttDeclCollection(ElementName);
  if Assigned(AttDeclCol) then begin
    if AttDeclCol.RemoveAttributeDecl(AttributeName) then begin
      Result := True;
      if AttDeclCol.AttributeDecls.Length = 0 then
        FAttDeclCollections.RemoveNamedItem(ElementName);
        AttDeclCol.Free;
    end else
      Result := False;
  end else
    Result := False;
end;

function TDtdModel.RemoveElementDecl(const Name: WideString): Boolean;
var
  Obj: TDtdObject;
begin
  Obj := FElementDeclarations.GetNamedItem(Name);
  if Assigned(Obj) then begin
    FElementDeclarations.RemoveNamedItem(Name);
    Obj.Free;
    Result := True;
  end else Result := False;
end;

function TDtdModel.RemoveEntityDecl(const Name: WideString): Boolean;
var
  EntityDecl: TDtdEntityDecl;
begin
  EntityDecl := FEntityDeclarations.GetNamedItem(Name) as TDtdEntityDecl;
  if Assigned(EntityDecl) then begin
    if EntityDecl.Origin <> DTD_PREDEFINED then begin
      FEntityDeclarations.RemoveNamedItem(Name);
      EntityDecl.Free;
      Result := True;
    end else
      Result := False;
  end else Result := False;
end;

function TDtdModel.RemoveNotationDecl(const Name: WideString): Boolean;
var
  Obj: TDtdObject;
begin
  Obj := FNotationDeclarations.GetNamedItem(Name);
  if Assigned(Obj) then begin
    FNotationDeclarations.RemoveNamedItem(Name);
    Obj.Free;
    Result := True;
  end else Result := False;
end;

function TDtdModel.SetAttributeDecl(const ElementName,
                                          AttrName,
                                          AttrValue: WideString;
                                    const Enumeration: TUtilsWideStringList;
                                    const AttrType: TXmlDataType;
                                    const ConstraintType: TDomAttrValueConstraint;
                                    const Origin: TDtdOrigin;
                                      out AttributeDecl: TDtdAttributeDecl): Boolean;
var
  AttDeclCol: TDtdAttDeclCollection;
begin
  AttDeclCol := FindAttDeclCollection(ElementName);
  if not Assigned(AttDeclCol) then begin
    AttDeclCol := TDtdAttDeclCollection.Create(Self, ElementName);
    FAttDeclCollections.SetNamedItem(AttDeclCol);
  end;
  Result := AttDeclCol.SetAttributeDecl(AttrName, AttrValue, Enumeration,
                         AttrType, ConstraintType, Origin, AttributeDecl);
end;

function TDtdModel.SetElementDecl(const Name: WideString;
                                  const ContentType: TDtdContentType;
                                  const Origin: TDtdOrigin;
                                    out ElementDecl: TDtdElementDecl): Boolean;
begin
  ElementDecl := FindElementDecl(Name);
  if Assigned(ElementDecl) then begin
    Result := False;
  end else begin
    ElementDecl := TDtdElementDecl.Create(Self, Name, ContentType, Origin);
    FElementDeclarations.SetNamedItem(ElementDecl);
    Result := True;
  end;
end;

function TDtdModel.SetEntityDecl(const Name,
                                       ReplacementText,
                                       PublicId,
                                       SystemId,
                                       NotationName,
                                       BaseUri: WideString;
                                 const Origin: TDtdOrigin;
                                   out EntityDecl: TDtdEntityDecl): Boolean;
begin
  if (Origin = DTD_PREDEFINED) and not FSetDefaults then
    raise ENot_Supported_Err.Create('Setting of predefined entity declarations not supported.');
  EntityDecl := FindEntityDecl(Name);
  if Assigned(EntityDecl) then begin
    Result := False;
  end else begin
    EntityDecl := TDtdEntityDecl.Create(Self, Name, ReplacementText, PublicId, SystemId, NotationName, BaseUri, Origin);
    FEntityDeclarations.SetNamedItem(EntityDecl);
    Result := True;
  end;
end;

function TDtdModel.SetNotationDecl(const Name,
                                         PublicId,
                                         SystemId: WideString;
                                   const Origin: TDtdOrigin;
                                     out NotationDecl: TDtdNotationDecl): Boolean;
begin
  NotationDecl := FindNotationDecl(Name);
  if Assigned(NotationDecl) then begin
    Result := False;
  end else begin
    NotationDecl := TDtdNotationDecl.Create(Self, Name, PublicId, SystemId, Origin);
    FNotationDeclarations.SetNamedItem(NotationDecl);
    Result := True;
  end;
end;

procedure TDtdModel.SetDefaults;
var
  Dummy: TDtdEntityDecl;
begin
  FSetDefaults := True;
  try
    FPEsInIntSubset := False;
    FPreparationStatus := PS_UNPREPARED;
    // Set the predefined entities:
    SetEntityDecl('lt', '&#60;', '', '', '', '', DTD_PREDEFINED, Dummy);
    SetEntityDecl('gt', #62, '', '', '', '', DTD_PREDEFINED, Dummy);
    SetEntityDecl('amp', '&#38;', '', '', '', '', DTD_PREDEFINED, Dummy);
    SetEntityDecl('apos', #39, '', '', '', '', DTD_PREDEFINED, Dummy);
    SetEntityDecl('quot', #34, '', '', '', '', DTD_PREDEFINED, Dummy);
  finally
    FSetDefaults := False;
  end;
end;

procedure TDtdModel.SetPreparationStatus(const Value: TDomPreparationStatus);
begin
  FPreparationStatus := Value;
end;



// +++++++++++++++++++++++++++ TXmlSourceCode ++++++++++++++++++++++++++
procedure TXmlSourceCode.calculatePieceOffset(const StartItem: Integer);
var
  Os, I: Integer;
begin
  if (StartItem < Count) and (StartItem >= 0) then begin
    if StartItem = 0
      then Os := 0
      else begin
        if not Assigned(Items[StartItem-1])
          then begin
            Pack;
            Exit;
          end else with TXmlSourceCodePiece(Items[StartItem-1]) do
            Os := FOffset + Length(FText);
      end;
    for I := StartItem to Pred(Count) do
      if not Assigned(Items[I])
        then begin
          Pack;
          Exit;
        end else with TXmlSourceCodePiece(Items[I]) do begin
          FOffset := Os;
          Os := Os + Length(FText);
        end;
  end; {if ...}
end;

function TXmlSourceCode.GetNameOfFirstTag: WideString;
var
  I, J, K: Integer;
begin
  Result := '';
  for I := 0 to Pred(Count) do
    if Assigned(Items[I]) then
      with TXmlSourceCodePiece(Items[I]) do
        if (PieceType = xmlStartTag) or (PieceType = xmlEmptyElementTag) then begin
          if PieceType = xmlStartTag
            then K := Length(Text) - 1
            else K := Length(Text) - 2;
          J := 1;
          while J < K do begin
            Inc(J);
            if IsXmlWhiteSpace(Text[J]) then Break;
            Result := Concat(Result, WideString(WideChar(Text[J])));
          end;
          Exit;
        end;
end;

function TXmlSourceCode.GetText: WideString;
var
  Content: TUtilsCustomWideStr;
  I: Integer;
begin
  Content:= TUtilsCustomWideStr.Create;
  try
    Content.AddWideChar(#$FFEF);  // Add byte order mark.
    for I := 0 to Pred(Count) do
      Content.AddWideString(TXmlSourceCodePiece(Items[I]).Text);
    Result := Content.Value;
  finally
    Content.Free;
  end;
end;

function TXmlSourceCode.Add(Item: Pointer): Integer;
begin
  if Assigned(Item) then begin
    if not Assigned(TXmlSourceCodePiece(Item).FOwner)
      then TXmlSourceCodePiece(Item).FOwner := Self
      else Error('Inuse source code piece error.', -1);
  end else Error('Item not Assigned error.', -1);
  Result := inherited Add(Item);
  CalculatePieceOffset(Result);
end;

procedure TXmlSourceCode.Clear;
var
  I: Integer;
begin
  for I := 0 to Pred(Count) do
    if Assigned(Items[I]) then
      with TXmlSourceCodePiece(Items[I]) do begin
        FOffset := 0;
        FOwner := nil;
      end;
  inherited Clear;
end;

procedure TXmlSourceCode.ClearAndFree;
var
  I: Integer;
begin
  for I := 0 to Pred(Count) do
    if Assigned(Items[I]) then TXmlSourceCodePiece(Items[I]).Free;
  inherited Clear;
end;

procedure TXmlSourceCode.Delete(Index: Integer);
begin
  if Assigned(Items[Index]) then
    with TXmlSourceCodePiece(Items[Index]) do begin
      FOffset := 0;
      FOwner := nil;
    end;
  inherited Delete(Index);
  CalculatePieceOffset(Index);
end;

procedure TXmlSourceCode.Exchange(Index1, Index2: Integer);
var
  Nr: Integer;
begin
  Nr := MinIntValue([Index1, Index2]);
  inherited Exchange(Index1, Index2);
  CalculatePieceOffset(Nr);
end;

function TXmlSourceCode.GetPieceAtPos(Pos: Integer): TXmlSourceCodePiece;
var
  I: Integer;
begin
  Result := nil;
  if Pos < 1 then Exit;
  for I := 0 to Pred(Count) do
    if not Assigned(Items[I]) then begin
      Pack;
      Result := GetPieceAtPos(Pos);
    end else with TXmlSourceCodePiece(Items[I]) do begin
      if (FOffset + Length(FText)) >= Pos then begin
        Result := TXmlSourceCodePiece(Items[I]);
        Exit;
      end;
    end;
end;

procedure TXmlSourceCode.Insert(Index: Integer; Item: Pointer);
begin
  if Assigned(Item) then begin
    if not Assigned(TXmlSourceCodePiece(Item).FOwner)
      then TXmlSourceCodePiece(Item).FOwner := Self
      else Error('Inuse source code piece error.', -1);
  end else Error('Item not Assigned error.', -1);
  inherited Insert(Index, Item);
  CalculatePieceOffset(Index);
end;

procedure TXmlSourceCode.Move(CurIndex, NewIndex: Integer);
var
  Nr: Integer;
begin
  Nr := MinIntValue([CurIndex, NewIndex]);
  inherited Move(CurIndex, NewIndex);
  CalculatePieceOffset(Nr);
end;

procedure TXmlSourceCode.Pack;
begin
  inherited Pack;
  CalculatePieceOffset(0);
end;

function TXmlSourceCode.Remove(Item: Pointer): Integer;
var
  Nr: Integer;
begin
  Nr := IndexOf(Item);
  Result := inherited Remove(Item);
  if Assigned(Items[Nr]) then
    with TXmlSourceCodePiece(Item) do begin
      FOffset := 0;
      FOwner := nil;
    end;
  CalculatePieceOffset(Nr);
end;

procedure TXmlSourceCode.Sort(Compare: TListSortCompare);
begin
  inherited Sort(Compare);
  CalculatePieceOffset(0);
end;



// ++++++++++++++++++++++++ TXmlSourceCodePiece ++++++++++++++++++++++++
constructor TXmlSourceCodePiece.Create(const pt: TDomPieceType);
begin
  FPieceType := pt;
  Ftext:= '';
  FOffset:= 0;
  FOwner := nil;
end;



// +++++++++++++++++++++++ TStandardResourceResolver +++++++++++++++++++++++
function TStandardResourceResolver.AcquireStreamFromUri(const Uri: WideString): TStream;
var
  Path: TFilename;
  Authority, Query, Fragment: string; // Only dummies.
  UriAnalyzer: TUriStrAnalyzer;
begin
  Result := nil;
  UriAnalyzer := TUriStrAnalyzer.Create;
  try
    with UriAnalyzer do begin

      SetUriReference(Uri);
      if not HasUriScheme then
        raise EFOpenError.CreateFmt('URI "%s" contains no scheme.', [Uri]);
      if UriScheme <> 'file' then
        raise EFOpenError.CreateFmt('URI scheme "%s" not supported.', [UriScheme]);

      UriStrToFilename(Uri, Path, Authority, Query, Fragment);
      if not FileExists(Path) then
        raise EFOpenError.CreateFmt('File "%s" not found.', [ExpandFileName(Path)]);
      Result := TFileStream.Create(Path, fmOpenRead);

    end;
  finally
    UriAnalyzer.Free;
  end;
end;

function TStandardResourceResolver.ResolveResource(const ABaseURI: WideString;
                                                     var PublicId,
                                                         SystemId: WideString): TStream;
// Remark: ResourceType and NamespaceURI are currently not evaluated.  They are
//         placeholders for XML Schema support in the future.  CertifiedText is
//         also not evaluated.  It is a placeholder for XML 1.1 support.
var
  ResourceType, NamespaceURI: WideString;
  CertifiedText: Boolean;
  Uri: WideString;
begin
  ResourceType := 'http://www.w3.org/TR/REC-xml';  // Signals an XML 1.0 resource.
  NamespaceURI := '';                              // Currently not used.
  CertifiedText := False;                          // Currently not used.

  Result := nil;

  // Calculate absolute system identifier:
  ResolveRelativeUriWideStr(ABaseUri, SystemId, Uri);
     // Remark: Returns an empty URI if ResolveRelativeUriWideStr attempt fails.
  SystemId := Uri;

  if Assigned(FOnResolveResource) then
    FOnResolveResource(Self, ResourceType, NamespaceURI, PublicId, SystemId, Result, CertifiedText);

  if not Assigned(Result) and (SystemId <> '') then begin
    try
      Result := AcquireStreamFromURI(SystemId);
    except
      Result.Free;
      Result := nil;
    end;
  end;
end;



{ TXmlSimpleInputSource }

constructor TXmlSimpleInputSource.Create(const Stream: TStream;
                                         const APublicId,
                                               ASystemId: WideString;
                                         const ABufSize: Integer;
                                         const ACodecClass: TUnicodeCodecClass;
                                         const InitialByteCount,
                                               InitialCharCount,
                                               InitialRegularCharsInLine,
                                               InitialTabsInLine,
                                               InitialLine: Int64;
                                               ReadLFOption: TCodecReadLFOption = lrNormalize);
begin
  FPublicId := APublicId;
  FSystemId := ASystemId;
  inherited Create(Stream, ABufSize, ACodecClass, InitialByteCount,
      InitialCharCount, InitialRegularCharsInLine + InitialTabsInLine, InitialTabsInLine,
      InitialLine, ReadLFOption);
end;

function TXmlSimpleInputSource.GetInputEncoding: WideString;
begin
  try
    Result := GetEncodingName(CodecClass);
  except
    Result := '';
  end;
end;



{ TXmlCustomInputSource }

constructor TXmlInputSource.Create(const Stream: TStream;
                                   const APublicId,
                                         ASystemId: WideString;
                                   const ABufSize: Integer;
                                   const ACodecClass: TUnicodeCodecClass;
                                   const InclDecl: Boolean;
                                   const InitialByteCount,
                                         InitialCharCount,
                                         InitialRegularCharsInLine,
                                         InitialTabsInLine,
                                         InitialLine: Int64;
                                         ReadLFOption: TCodecReadLFOption = lrNormalize);
var
  NewCodecClass: TUnicodeCodecClass;
begin
  inherited Create(Stream, APublicId, ASystemId, ABufSize, ACodecClass,
      InitialByteCount, InitialCharCount, InitialRegularCharsInLine,
      InitialTabsInLine, InitialLine, ReadLFOption);

  FHasMalformedDecl := not EvaluateXmlOrTextDecl(FDeclType, FXmlVersion,
                             FXmlEncoding, FXmlStandalone);

  if not Assigned(ACodecClass) then begin
    // Calculate codec class as specified in XML or text declaration:
    if FXmlEncoding <> '' then begin

      try
        NewCodecClass := StrToEncoding(UTF16ToEncoding(TUSASCIICodec, FXmlEncoding));
      except
        NewCodecClass := nil;
      end;

      if Assigned(NewCodecClass)then begin

        if HasByteOrderMark and
           ( ( (CodecClass = TUTF16BECodec) and (NewCodecClass <> TUTF16BECodec) and (NewCodecClass <> TUCS2Codec) ) or
             ( (CodecClass = TUTF16LECodec) and (NewCodecClass <> TUTF16LECodec) ) or
             ( (CodecClass = TUTF8Codec)    and (NewCodecClass <> TUTF8Codec)    ) ) then
          raise EConvertError.Create('Declared encoding does not match byte order mark.');
        SetCodecClass(NewCodecClass);

      end else begin

        if CompareText(UTF16ToEncoding(TUSASCIICodec, FXmlEncoding), 'UTF-16') = 0 then begin
          if not HasByteOrderMark then begin
            SetCodecClass(TUTF16BECodec);
            // Cf. RFC 2781: "UTF-16, an encoding of ISO 10646", sec. 4.3:
            //   If the first two octets of the text is not 0xFE followed by
            //   0xFF, and is not 0xFF followed by 0xFE, then the text SHOULD be
            //   interpreted as being big-endian.
          end else if not ( (CodecClass = TUTF16BECodec) or
                            (CodecClass = TUTF16LECodec) ) then
            raise EConvertError.Create('Declared encoding does not match byte order mark.');
        end else
          raise ENot_Supported_Err.Create('Encoding not supported error.');

      end;

    end; {if FXmlEncoding ...}

  end; {if not Assigned(ACodecClass) ...}

  if not InclDecl then
    InitialUCS4CharData := CurrentCharInfo;
  Reset;
end;

function TXmlInputSource.EvaluateXmlOrTextDecl(out DeclType: TDomXMLDeclType;
                                               out Version,
                                                   EncName: WideString;
                                               out Standalone: TDomStandalone): Boolean;
var
  QM: UCS4Char;
  WhitespaceSkipped: Boolean;
begin
  Result := True;
  DeclType := DT_UNSPECIFIED;
  EncName := '';
  Version := '1.0';  // Version 1.0 is the default.  Cf. XML 1.1, sec. 4.3.4.
  Standalone := STANDALONE_UNSPECIFIED;
  try
    if Match('<?xml') then begin // Does the stream start with '<?xml'?
      DeclType := DT_XML_OR_TEXT_DECLARATION;

      WhitespaceSkipped := SkipNext(GetXmlWhitespaceWideString) > 0;

      // version:
      if CurrentCharInfo.CodePoint = $0076 then begin // 'v'
        if not WhitespaceSkipped then begin
          Result := False;
          Exit;
        end;
        if Match('ersion') then begin
          SkipNext(GetXmlWhitespaceWideString);
          if not ( CurrentCharInfo.CodePoint = $003D ) then begin  // '='
            Result := False;
            Exit;
          end;
          SkipNext(GetXmlWhitespaceWideString);
          if not ( ( CurrentCharInfo.CodePoint = $0022 ) or
                   ( CurrentCharInfo.CodePoint = $0027 ) ) then begin  // '"' or '''
            Result := False;
            Exit;
          end;
          QM := CurrentCharInfo.CodePoint;
          Next;
          if IsXmlVersionNumCharCodePoint(CurrentCharInfo.CodePoint) then begin
            Version := WideString(WideChar(CurrentCharInfo.CodePoint));
          end else begin
            Result := False;
            Exit;
          end;
          Next;
          while IsXmlVersionNumCharCodePoint(CurrentCharInfo.CodePoint) do begin
            Version := Concat(Version, WideString(WideChar(CurrentCharInfo.CodePoint)));
            Next;
          end;
          if CurrentCharInfo.CodePoint <> QM then begin  // Is the first quotation mark of the same type as the second?
            Result := False;
            Exit;
          end;
          WhitespaceSkipped := SkipNext(GetXmlWhitespaceWideString) > 0;
        end else begin
          Result := False;
          Exit;
        end; {if ... else ...}
      end else DeclType := DT_TEXT_DECLARATION;

      // EncodingDecl:
      if CurrentCharInfo.CodePoint = $0065 then begin // 'e'
        if not WhitespaceSkipped then begin
          Result := False;
          Exit;
        end;
        if Match('ncoding') then begin
          SkipNext(GetXmlWhitespaceWideString);
          if not ( CurrentCharInfo.CodePoint = $003D ) then begin  // '='
            Result := False;
            Exit;
          end;
          SkipNext(GetXmlWhitespaceWideString);
          if not ( ( CurrentCharInfo.CodePoint = $0022 ) or
                   ( CurrentCharInfo.CodePoint = $0027 ) ) then begin  // '"' or '''
            Result := False;
            Exit;
          end;
          QM := CurrentCharInfo.CodePoint;
          Next;
          if IsXmlEncNameLeadingCharCodePoint(CurrentCharInfo.CodePoint) then begin
            EncName := WideString(WideChar(CurrentCharInfo.CodePoint));
          end else begin
            Result := False;
            Exit;
          end;
          Next;
          while IsXmlEncNameFollowingCharCodePoint(CurrentCharInfo.CodePoint) do begin
            EncName := Concat(EncName, WideString(WideChar(CurrentCharInfo.CodePoint)));
            Next;
          end;
          if CurrentCharInfo.CodePoint <> QM then begin  // Is the first quotation mark of the same type as the second?
            Result := False;
            Exit;
          end;
          WhitespaceSkipped := SkipNext(GetXmlWhitespaceWideString) > 0;
        end else begin
          Result := False;
          Exit;
        end; {if ... else ...}
      end else begin
        if DeclType = DT_TEXT_DECLARATION then begin
          Result := False;
          Exit;
        end else DeclType := DT_XML_DECLARATION;
      end; {if ... else ...}

      // SDDecl:
      if CurrentCharInfo.CodePoint = $0073 then begin // 's'
        if not WhitespaceSkipped then begin
          Result := False;
          Exit;
        end;
        if Match('tandalone') then begin
          SkipNext(GetXmlWhitespaceWideString);
          if not ( CurrentCharInfo.CodePoint = $003D ) then begin  // '='
            Result := False;
            Exit;
          end;
          SkipNext(GetXmlWhitespaceWideString);
          if not ( ( CurrentCharInfo.CodePoint = $0022 ) or
                   ( CurrentCharInfo.CodePoint = $0027 ) ) then begin  // '"' or '''
            Result := False;
            Exit;
          end;
          QM := CurrentCharInfo.CodePoint;
          Next;

          case CurrentCharInfo.CodePoint of
            $0079: begin // 'y'
              Next;
              if CurrentCharInfo.CodePoint = $0065 then begin  // 'e'
                Next;
                if CurrentCharInfo.CodePoint = $0073 then begin // 's'
                  Standalone := STANDALONE_YES;
                end else begin
                  Result := False;
                  Exit;
                end;
              end else begin
                Result := False;
                Exit;
              end;
            end;
            $006e: begin // 'n'
              Next;
              if CurrentCharInfo.CodePoint = $006f then begin // 'o'
                Standalone := STANDALONE_NO;
              end else begin
                Result := False;
                Exit;
              end;
            end;
          else
            Result := False;
            Exit;
          end; {case ...}
          Next;
          if CurrentCharInfo.CodePoint <> QM then begin  // Is the first quotation mark of the same type as the second?
            Result := False;
            Exit;
          end;
          SkipNext(GetXmlWhitespaceWideString);
        end else begin
          Result := False;
          Exit;
        end; {if ... else ...}
        if DeclType = DT_TEXT_DECLARATION then begin
          Result := False;
          Exit;
        end else DeclType := DT_XML_DECLARATION;
      end; {if ...}

      // '?>':
      if (CurrentCharInfo.CodePoint = $003F) // '?'
        and Match('>') then begin   // '>'

        ResetPosition := Position - NextCharInfo.Size;

      end else
        Result := False;

    end else
      Reset;

  except
    Result := False;
  end; {try ...}
end;



{ TXmlCustomTokenizer }

constructor TXmlCustomTokenizer.Create(const InputSource: TXmlSimpleInputSource);
begin
  inherited Create;
  FTokenValue := TUtilsCustomWideStr.Create;
  FInputSource := InputSource;
  FTokenStart := InputSource.CurrentCharInfo;
  FTokenEnd := InputSource.PreviousCharInfo;
  FErrorType := ET_NONE;
end;

destructor TXmlCustomTokenizer.Destroy;
begin
  FTokenValue.Free;
  inherited;
end;

function TXmlCustomTokenizer.GetEndByteNumber: Int64;
begin
  Result := FTokenEnd.ByteCount;
end;

function TXmlCustomTokenizer.GetEndCharNumber: Int64;
begin
  Result := FTokenEnd.CharCount;
end;

function TXmlCustomTokenizer.GetEndColumnNumber: Int64;
begin
  Result := FTokenEnd.CharsInLine;
end;

function TXmlCustomTokenizer.GetEndLineNumber: Int64;
begin
  Result := FTokenEnd.Line;
end;

function TXmlCustomTokenizer.GetEndTabsInLine: Int64;
begin
  Result := FTokenEnd.TabsInLine;
end;

function TXmlCustomTokenizer.GetRelatedDtdObject: TDtdObject;
begin
  Result := nil;
end;

function TXmlCustomTokenizer.GetRelatedNode: TDomNode;
begin
  Result := nil;
end;

function TXmlCustomTokenizer.GetStartByteNumber: Int64;
begin
  with FTokenStart do
    Result := ByteCount - Size;
end;

function TXmlCustomTokenizer.GetStartCharNumber: Int64;
begin
  Result := FTokenStart.CharCount;
end;

function TXmlCustomTokenizer.GetStartColumnNumber: Int64;
begin
  Result := FTokenStart.CharsInLine;
end;

function TXmlCustomTokenizer.GetStartLineNumber: Int64;
begin
  Result := FTokenStart.Line;
end;

function TXmlCustomTokenizer.GetStartTabsInLine: Int64;
begin
  Result := FTokenStart.TabsInLine;
end;

function TXmlCustomTokenizer.GetTokenValue: WideString;
begin
  Result := FTokenValue.Value;
end;

function TXmlCustomTokenizer.GetUri: WideString;
begin
  Result := FInputSource.SystemId;
end;



{ TXmlDocTokenizer }

constructor TXmlDocTokenizer.Create(const InputSource: TXmlSimpleInputSource);
begin
  inherited Create(InputSource);
  if Assigned(InputSource)
    then FTokenType := XML_START_OF_SOURCE_TOKEN
    else FTokenType := XML_END_OF_SOURCE_TOKEN;
end;

procedure TXmlDocTokenizer.Next;
const
  EM_CODE          = $21; // code of !
  DQ_CODE          = $22; // code of "
  NUMBER_CODE      = $23; // code of #
  AMP_CODE         = $26; // code of &
  SQ_CODE          = $27; // code of '
  HYPHEN_CODE      = $2D; // code of -
  SOLIDUS_CODE     = $2F; // code of /
  COLON_CODE       = $3A; // code of :
  SEMICOLON_CODE   = $3B; // code of ;
  LT_CODE          = $3C; // code of <
  GT_CODE          = $3E; // code of >
  QM_CODE          = $3F; // code of ?
  CAPITAL_C_CODE   = $43; // code of C
  CAPITAL_D_CODE   = $44; // code of D
  CAPITAL_O_CODE   = $4F; // code of O
  LS_BRACKET_CODE  = $5B; // code of [
  RS_BRACKET_CODE  = $5D; // code of ]
  LOW_LINE_CODE    = $5F; // code of _
  SMALL_C_CODE     = $63; // code of c
  SMALL_D_CODE     = $64; // code of d
  SMALL_O_CODE     = $6F; // code of o
  SMALL_X_CODE     = $78; // code of x
  STRING_TERMINATOR_CODE = $9C;

  CDATA_START: array[0..5] of UCS4Char =
    (Ord('C'), Ord('D'), Ord('A'), Ord('T'), Ord('A'), Ord('['));
  DOCTYPE_START: array[0..5] of UCS4Char =
    (Ord('O'), Ord('C'), Ord('T'), Ord('Y'), Ord('P'), Ord('E'));

  PIEND: WideString = '?>';
var
  I: Integer;
  SubEndMarker, SubStartMarker: WideString;
  SQ_Open, DQ_Open, Bracket_Open: Boolean;
begin
  if FTokenType = XML_END_OF_SOURCE_TOKEN then Exit;

  FTokenValue.Clear;
  FErrorType := ET_NONE;
  FClue := '';
  FTokenStart := FInputSource.NextCharInfo;

  try
    FInputSource.Next;

    case FInputSource.CurrentCharInfo.CodePoint of

      // '<' found:
      LT_CODE: begin
        case FInputSource.NextCharInfo.CodePoint of

          // '/' --> End Tag found:
          SOLIDUS_CODE: begin
            FTokenType := XML_END_TAG_TOKEN;
            FInputSource.Next;
            FTokenStart := FInputSource.NextCharInfo;
            while not ( IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) or
                        (FInputSource.NextCharInfo.CodePoint = GT_CODE) or // '>'
                        (FInputSource.NextCharInfo.CodePoint = STRING_TERMINATOR_CODE) ) do begin
              FInputSource.Next;
              FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            end;
            FTokenEnd := FInputSource.CurrentCharInfo;
            while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do // Skip whitespace.
              FInputSource.Next;
            if FInputSource.NextCharInfo.CodePoint = GT_CODE then begin// '>' ?
              FInputSource.Next;
            end else begin
              FErrorType := ET_UNCLOSED_ELEMENT;
              FClue := '>';
            end;
          end;

          // '?' --> Processing Instruction found:
          QM_CODE: begin
            FTokenType := XML_PI_TOKEN;
            FInputSource.Next;
            FTokenStart := FInputSource.NextCharInfo;
            while FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
              FInputSource.Next;
              if (FInputSource.CurrentCharInfo.CodePoint = QM_CODE) and
                 (FInputSource.NextCharInfo.CodePoint = GT_CODE)
              then begin
                // '?>' found:
                FTokenEnd := FInputSource.PreviousCharInfo;
                FInputSource.Next;
                Exit;
              end;
              FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            end;
            FTokenEnd := FInputSource.PreviousCharInfo;
            FErrorType := ET_UNCLOSED_PROCESSING_INSTRUCTION;
            FClue := '?';
          end;

          // '!' --> Comment, CDATA Section or Document Type Declaration found:
          EM_CODE: begin
            FInputSource.Next;
            case FInputSource.NextCharInfo.CodePoint of

              HYPHEN_CODE: begin // '-' --> Comment found:
                FTokenType := XML_COMMENT_TOKEN;
                FInputSource.Next;
                if FInputSource.NextCharInfo.CodePoint = HYPHEN_CODE then begin // '<!--' found:
                  FInputSource.Next;
                  FTokenStart := FInputSource.NextCharInfo;
                  while FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
                    FInputSource.Next;
                    if FInputSource.CurrentCharInfo.CodePoint = HYPHEN_CODE then begin // '-' found
                      FTokenEnd := FInputSource.PreviousCharInfo;
                      FInputSource.Next;
                      case FInputSource.CurrentCharInfo.CodePoint of
                        HYPHEN_CODE: begin // Second '-'
                          if FInputSource.NextCharInfo.CodePoint = GT_CODE then begin// '>'?
                            FInputSource.Next;
                          end else begin
                            FTokenEnd := FInputSource.CurrentCharInfo;
                            FErrorType := ET_DOUBLE_HYPHEN_IN_COMMENT;
                            FClue := '>';
                          end;
                          Exit;
                        end;
                        STRING_TERMINATOR_CODE: begin
                          FTokenEnd := FInputSource.PreviousCharInfo;
                          FErrorType := ET_UNCLOSED_COMMENT;
                          FClue := '-->';
                          Exit;
                        end;
                      else
                        // No second '-' --> Add '-' to content of comment:
                        FTokenValue.AddUCS4Char(HYPHEN_CODE);
                      end;
                    end;
                    FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
                  end;
                  FTokenEnd := FInputSource.CurrentCharInfo;
                  FErrorType := ET_UNCLOSED_COMMENT;
                  FClue := '-->';
                  Exit;
                end;
                FTokenEnd := FInputSource.CurrentCharInfo;
                FErrorType := ET_COMMENT_START_EXPECTED;
                FClue := '<!--';
              end;

              LS_BRACKET_CODE: begin // '[' --> CDATA Section found:
                FTokenType := XML_CDATA_TOKEN;
                FInputSource.Next;
                for I := 0 to 5 do
                  if FInputSource.NextCharInfo.CodePoint = CDATA_START[I] then begin
                    FInputSource.Next;
                  end else begin
                    FTokenEnd := FInputSource.CurrentCharInfo;
                    FErrorType := ET_CDATA_START_EXPECTED;
                    FClue := '<![CDATA[';
                    Exit;
                  end;
                FTokenStart := FInputSource.NextCharInfo;
                while FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
                  FInputSource.Next;
                  while (FInputSource.CurrentCharInfo.CodePoint = RS_BRACKET_CODE) and
                        (FInputSource.NextCharInfo.CodePoint = RS_BRACKET_CODE) do begin
                    // ']]' found:
                    FTokenEnd := FInputSource.PreviousCharInfo;
                    FInputSource.Next;
                    if FInputSource.NextCharInfo.CodePoint = GT_CODE then begin
                      // '>' found:
                      FInputSource.Next;
                      Exit;
                    end else
                      FTokenValue.AddUCS4Char(RS_BRACKET_CODE);
                  end;
                  FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
                end;
                FTokenEnd := FInputSource.CurrentCharInfo;
                FErrorType := ET_UNCLOSED_CDATA_SECTION;
                FClue := ']]>';
              end;

              CAPITAL_D_CODE: begin // 'D' --> Document Type Declaration found:
                FTokenType := XML_DOCTYPE_TOKEN;
                FInputSource.Next;
                for I := 0 to 5 do
                  if FInputSource.NextCharInfo.CodePoint = DOCTYPE_START[I] then begin
                    FInputSource.Next;
                  end else begin
                    FErrorType := ET_DOCTYPE_START_EXPECTED;
                    FClue := '<!DOCTYPE';
                    Exit;
                  end;
                DQ_Open := False;
                SQ_Open := False;
                Bracket_Open := False;
                SubStartMarker := '';
                SubEndMarker := '';
                FTokenStart := FInputSource.NextCharInfo;
                while FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
                  FInputSource.Next;
                  if (FInputSource.CurrentCharInfo.CodePoint = GT_CODE) // '>'
                     and (not DQ_Open)
                     and (not SQ_Open)
                     and (not Bracket_Open)
                     and (SubEndMarker = '')
                    then begin
                      FTokenEnd := FInputSource.PreviousCharInfo;
                      Exit;
                    end;
                  FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);

                  if (SubEndMarker = '') then begin

                    if (FInputSource.CurrentCharInfo.CodePoint = SQ_CODE) and (not DQ_Open) then begin
                      SQ_Open := not SQ_Open;
                    end else if (FInputSource.CurrentCharInfo.CodePoint = DQ_CODE) and (not SQ_Open) then begin
                      DQ_Open := not DQ_Open;
                    end;

                    if Bracket_Open then begin
                      if not (SQ_Open or DQ_Open) then begin
                        if FInputSource.CurrentCharInfo.CodePoint = LT_CODE then begin  // '<'
                          SubStartMarker := '<';
                        end else if (FInputSource.CurrentCharInfo.CodePoint = EM_CODE) and (SubStartMarker = '<') then begin // '!'
                          SubStartMarker := '<!';
                        end else if (FInputSource.CurrentCharInfo.CodePoint = QM_CODE) and (SubStartMarker = '<') then begin // '?'
                          SubStartMarker := '';
                          SubEndMarker := PIEND;
                        end else if (FInputSource.CurrentCharInfo.CodePoint = HYPHEN_CODE) and (SubStartMarker = '<!')then begin // '-'
                          SubStartMarker := '<!-';
                        end else if (FInputSource.CurrentCharInfo.CodePoint = HYPHEN_CODE) and (SubStartMarker = '<!-')then begin // '-'
                          SubStartMarker := '';
                          SubEndMarker := '-->';
                        end else if SubStartMarker <> '' then begin
                          SubStartMarker := '';
                        end;
                        if (FInputSource.CurrentCharInfo.CodePoint = RS_BRACKET_CODE) // ']'
                          and (not SQ_Open)
                          and (not DQ_Open)
                          then Bracket_Open:= False;
                      end; {if not ...}
                    end else begin {if BracketOpened ... }
                      if (FInputSource.CurrentCharInfo.CodePoint = LS_BRACKET_CODE) // '['
                        and (not SQ_Open)
                        and (not DQ_Open) then Bracket_Open:= True;
                    end; {if BracketOpened ... else ...}

                  end else begin; {if (SubEndMarker = '') ...}
                    if FTokenValue.endsWith(SubEndMarker) then SubEndMarker := '';
                  end; {if (SubEndMarker = '') ... else ...}

                end;
                FTokenEnd := FInputSource.CurrentCharInfo;
                FErrorType := ET_UNCLOSED_DOCTYPE;
                FClue := ']>';
              end;

              SMALL_D_CODE, CAPITAL_O_CODE, SMALL_O_CODE: begin // 'd', 'O' 'o' --> Possible Document Type Declaration typo found:
                FTokenEnd := FInputSource.CurrentCharInfo;
                FTokenType := XML_DOCTYPE_TOKEN;
                FErrorType := ET_DOCTYPE_START_EXPECTED;
                FClue := '<!DOCTYPE';
              end;

              RS_BRACKET_CODE, CAPITAL_C_CODE, SMALL_C_CODE: begin // ']' 'C', 'c' --> Possible CDATA section typo found:
                FTokenEnd := FInputSource.CurrentCharInfo;
                FTokenType := XML_CDATA_TOKEN;
                FErrorType := ET_CDATA_START_EXPECTED;
                FClue := '<![CDATA[';
              end;

            else
              FTokenEnd := FInputSource.CurrentCharInfo;
              FTokenType := XML_COMMENT_TOKEN;
              FErrorType := ET_COMMENT_START_EXPECTED;
              FClue := '<!--';
            end;
          end;

          GT_CODE: begin
            FTokenEnd := FInputSource.CurrentCharInfo;
            FInputSource.Next;
            FTokenType := XML_START_TAG_TOKEN;
            FErrorType := ET_MISSING_ELEMENT_NAME;
          end;

          STRING_TERMINATOR_CODE: begin
            FTokenEnd := FInputSource.CurrentCharInfo;
            FTokenType := XML_START_TAG_TOKEN;
            FErrorType := ET_MISSING_ELEMENT_NAME;
          end;

        else

          // Start Tag or Empty Element Tag found:
          SQ_Open:= False;
          DQ_Open:= False;
          FInputSource.Next;
          FTokenStart := FInputSource.CurrentCharInfo;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          while not (FInputSource.NextCharInfo.CodePoint in [SOLIDUS_CODE, GT_CODE, STRING_TERMINATOR_CODE]) do begin
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            if FInputSource.CurrentCharInfo.CodePoint = SQ_CODE then
              SQ_Open:= True;
            if FInputSource.CurrentCharInfo.CodePoint = DQ_CODE then
              DQ_Open:= True;
            while SQ_Open and (FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE) do begin
              FInputSource.Next;
              FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
              if FInputSource.CurrentCharInfo.CodePoint = SQ_CODE then
                SQ_Open:= False;
            end;
            while DQ_Open and (FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE) do begin
              FInputSource.Next;
              FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
              if FInputSource.CurrentCharInfo.CodePoint = DQ_CODE then
                DQ_Open:= False;
            end;
          end;
          FTokenEnd := FInputSource.CurrentCharInfo;
          case FInputSource.NextCharInfo.CodePoint of
            SOLIDUS_CODE: begin
              FTokenType := XML_EMPTY_ELEMENT_TAG_TOKEN;
              FInputSource.Next;
              if FInputSource.NextCharInfo.CodePoint = GT_CODE then begin
                FInputSource.Next;
              end else begin
                FErrorType := ET_UNCLOSED_ELEMENT;
                FClue := '>';
              end;
            end;
            GT_CODE: begin
              FTokenType := XML_START_TAG_TOKEN;
              FInputSource.Next;
            end;
            STRING_TERMINATOR_CODE: begin
              FTokenType := XML_START_TAG_TOKEN;
              FErrorType := ET_UNCLOSED_ELEMENT;
              if SQ_Open then begin
                FClue := '''>';
              end else if DQ_Open then begin
                FClue := '">';
              end else
                FClue := '>';
            end;
          end;
        end;
      end;

      // Start of reference ('&') found:
      AMP_CODE: begin
        if FInputSource.NextCharInfo.CodePoint = NUMBER_CODE then begin // '#' found --> Character reference.
          FInputSource.Next;

          if FInputSource.NextCharInfo.CodePoint = SMALL_X_CODE then begin // 'x' found --> Hexadecimal character reference.
            FTokenType := XML_CHAR_REF_HEX_TOKEN;
            FInputSource.Next;
            FTokenStart := FInputSource.NextCharInfo;
            while IsXmlHexDigitCodePoint(FInputSource.NextCharInfo.CodePoint) do begin
              FInputSource.Next;
              FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            end;
          end else begin // Decimal character reference
            FTokenType := XML_CHAR_REF_DEC_TOKEN;
            FTokenStart := FInputSource.NextCharInfo;
            while IsXmlDecDigitCodePoint(FInputSource.NextCharInfo.CodePoint) do begin
              FInputSource.Next;
              FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            end;
          end;
          FTokenEnd := FInputSource.CurrentCharInfo;
          if FInputSource.NextCharInfo.CodePoint = SEMICOLON_CODE then begin // ';' found
            FInputSource.Next;
          end else begin
            FErrorType := ET_UNCLOSED_CHAR_REF;
            FClue := ';';
          end;

        end else begin // Entity reference
          FTokenType := XML_ENTITY_REF_TOKEN;

          FTokenStart := FInputSource.NextCharInfo;
          if IsXmlLetterCodePoint(FInputSource.NextCharInfo.CodePoint) or
             (FInputSource.NextCharInfo.CodePoint = COLON_CODE) or
             (FInputSource.NextCharInfo.CodePoint = LOW_LINE_CODE)
          then begin
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            while IsXmlNameCharCodePoint(FInputSource.NextCharInfo.CodePoint) do begin
              FInputSource.Next;
              FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            end;
            FTokenEnd := FInputSource.CurrentCharInfo;
            if FInputSource.NextCharInfo.CodePoint = SEMICOLON_CODE then begin// ';' found
              FInputSource.Next;
            end else begin
              FErrorType := ET_UNCLOSED_ENTITY_REF;
              FClue := ';';
            end;
          end else begin
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_MISSING_ENTITY_NAME;
          end;
        end;
      end;

      // End of source found:
      STRING_TERMINATOR_CODE: begin
        FTokenEnd := FInputSource.CurrentCharInfo;
        FTokenType := XML_END_OF_SOURCE_TOKEN;
      end;

    else
      // PCDATA found:
      FTokenType := XML_PCDATA_TOKEN;
      FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
      while not (FInputSource.NextCharInfo.CodePoint in [AMP_CODE, LT_CODE, STRING_TERMINATOR_CODE]) do begin
        FInputSource.Next;
        FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
      end;
      FTokenEnd := FInputSource.CurrentCharInfo;
    end;

  except
    on EConvertError do begin
      FTokenEnd := FInputSource.CurrentCharInfo;
      FErrorType := ET_INVALID_CHARACTER;
    end;
  end; {try ...}
end;



{ TXmlDoctypeDeclTokenizer }

constructor TXmlDoctypeDeclTokenizer.Create(const S,
                                                  DocumentUri: WideString;
                                                  InitialByteCount,
                                                  InitialCharCount,
                                                  InitialRegularCharsInLine,
                                                  InitialTabsInLine,
                                                  InitialLine: Int64);
begin
  inherited Create;
  if InitialRegularCharsInLine < 0 then // Indicates a starting LF
    Dec(InitialLine);   
  FInputSource := nil;  // Remark: If an exception occurs, the destructor is automatically called.
  FStringStream := nil; //         Therefore, we need to initialize critical objects with nil first.
  FTokenValue := TUtilsCustomWideStr.Create;
  FStringStream := TUtilsWideStringStream.Create(S);
  FInputSource := TXmlSimpleInputSource.Create(FStringStream, '', DocumentUri, 4096,
                   TUTF16LECodec, InitialByteCount, InitialCharCount,
                   InitialRegularCharsInLine, InitialTabsInLine, InitialLine); 

  FTokenStart := FInputSource.CurrentCharInfo;
  FTokenEnd := FInputSource.PreviousCharInfo;
  FTokenType := DOCTYPE_START_OF_SOURCE_TOKEN;
  FErrorType := ET_NONE;
end;

destructor TXmlDoctypeDeclTokenizer.Destroy;
begin
  FInputSource.Free;  // Remark: Free the Reader before the stream.
  FStringStream.Free;
  FTokenValue.Free;
  inherited;
end;

function TXmlDoctypeDeclTokenizer.GetEndByteNumber: Int64;
begin
  Result := FTokenEnd.ByteCount;
end;

function TXmlDoctypeDeclTokenizer.GetEndCharNumber: Int64;
begin
  Result := FTokenEnd.CharCount;
end;

function TXmlDoctypeDeclTokenizer.GetEndColumnNumber: Int64;
begin
  Result := FTokenEnd.CharsInLine;
end;

function TXmlDoctypeDeclTokenizer.GetEndLineNumber: Int64;
begin
  Result := FTokenEnd.Line;
end;

function TXmlDoctypeDeclTokenizer.GetEndTabsInLine: Int64;
begin
  Result := FTokenEnd.TabsInLine;
end;

function TXmlDoctypeDeclTokenizer.GetRelatedDtdObject: TDtdObject;
begin
  Result := nil;
end;

function TXmlDoctypeDeclTokenizer.GetRelatedNode: TDomNode;
begin
  Result := nil;
end;

function TXmlDoctypeDeclTokenizer.GetStartByteNumber: Int64;
begin
  with FTokenStart do
    Result := ByteCount - Size;
end;

function TXmlDoctypeDeclTokenizer.GetStartCharNumber: Int64;
begin
  Result := FTokenStart.CharCount;
end;

function TXmlDoctypeDeclTokenizer.GetStartColumnNumber: Int64;
begin
  Result := FTokenStart.CharsInLine;
end;

function TXmlDoctypeDeclTokenizer.GetStartLineNumber: Int64;
begin
  Result := FTokenStart.Line;
end;

function TXmlDoctypeDeclTokenizer.GetStartTabsInLine: Int64;
begin
  Result := FTokenStart.TabsInLine;
end;

function TXmlDoctypeDeclTokenizer.GetTokenValue: WideString;
begin
  Result := FTokenValue.Value;
end;

function TXmlDoctypeDeclTokenizer.GetUri: WideString;
begin
  Result := FInputSource.SystemId;
end;

procedure TXmlDoctypeDeclTokenizer.Next;
const
  EM_CODE          = $21; // code of !
  DQ_CODE          = $22; // code of "
  SQ_CODE          = $27; // code of '
  HYPHEN_CODE      = $2D; // code of -
  LT_CODE          = $3C; // code of <
  GT_CODE          = $3E; // code of >
  QM_CODE          = $3F; // code of ?
  CAPITAL_P_CODE   = $50; // code of P
  CAPITAL_S_CODE   = $53; // code of S
  LS_BRACKET_CODE  = $5B; // code of [
  RS_BRACKET_CODE  = $5D; // code of ]
  STRING_TERMINATOR_CODE = $9C;

  PUBLIC_ID_START: array[0..4] of UCS4Char =
    (Ord('U'), Ord('B'), Ord('L'), Ord('I'), Ord('C'));
  SYSTEM_ID_START: array[0..4] of UCS4Char =
    (Ord('Y'), Ord('S'), Ord('T'), Ord('E'), Ord('M'));
var
  CommentStartFound: Boolean;
  CommentEndFound: Boolean;
  DoctypeNameStart: Boolean;
  DQ_Open: Boolean;
  EM_Found: Boolean;
  I: Integer;
  InComment: Boolean;
  InPI: Boolean;
  LT_Found: Boolean;
  QuoteCode: UCS4Char;
  SQ_Open: Boolean;
begin
  if FTokenType = DOCTYPE_END_OF_SOURCE_TOKEN then Exit;

  FTokenValue.Clear;
  FErrorType := ET_NONE;
  FClue := '';
  FTokenStart := FInputSource.NextCharInfo;

  try

    case FTokenType of
      DOCTYPE_INTSUBSET_TOKEN:
        begin
          // Skip whitespace:
          while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do
            FInputSource.Next;

          FInputSource.Next;
          if FInputSource.CurrentCharInfo.CodePoint = STRING_TERMINATOR_CODE then begin
            FTokenEnd := FInputSource.PreviousCharInfo;
            FTokenType := DOCTYPE_END_OF_SOURCE_TOKEN
          end else begin
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_UNCLOSED_DOCTYPE;
          end;
        end;

      DOCTYPE_NAME_TOKEN:
        begin
          // Skip optional whitespace:
          while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do
            FInputSource.Next;

          case FInputSource.NextCharInfo.CodePoint of
            STRING_TERMINATOR_CODE:
              begin
                FInputSource.Next;
                FTokenEnd := FInputSource.PreviousCharInfo;
                FTokenType := DOCTYPE_END_OF_SOURCE_TOKEN;
              end;
            CAPITAL_P_CODE: // 'P' --> 'PUBLIC' found.
              begin
                FInputSource.Next;
                FTokenStart := FInputSource.CurrentCharInfo;
                for I := 0 to 4 do
                  if FInputSource.NextCharInfo.CodePoint = PUBLIC_ID_START[I] then begin
                    FInputSource.Next;
                  end else begin
                    FTokenEnd := FInputSource.CurrentCharInfo;
                    FErrorType := ET_PUBLIC_KEYWORD_EXPECTED;
                    FClue := 'PUBLIC';
                    Exit;
                  end;

                FTokenType := DOCTYPE_PUBID_TOKEN;
                FTokenStart := FInputSource.NextCharInfo;

                // Check for whitespace:
                if not IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) then begin
                  FTokenEnd := FInputSource.CurrentCharInfo;
                  FErrorType := ET_MISSING_WHITE_SPACE;
                  FClue := ' ';
                  Exit;
                end;

                // Skip whitespace:
                FInputSource.Next;
                while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do
                  FInputSource.Next;

                FTokenStart := FInputSource.NextCharInfo;

                // Find public identifier:
                if not (FInputSource.NextCharInfo.CodePoint in [DQ_CODE, SQ_CODE]) then begin
                  FTokenEnd := FInputSource.CurrentCharInfo;
                  FErrorType := ET_QUOTATION_MARK_EXPECTED;
                  FClue := '"';
                  Exit;
                end;
                FInputSource.Next;
                FTokenStart := FInputSource.NextCharInfo;
                QuoteCode := FInputSource.CurrentCharInfo.CodePoint;
                while not (FInputSource.NextCharInfo.CodePoint in [QuoteCode, STRING_TERMINATOR_CODE]) do begin
                  FInputSource.Next;
                  FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
                end;
                FTokenEnd := FInputSource.CurrentCharInfo;
                if FInputSource.NextCharInfo.CodePoint <> QuoteCode then begin
                  FErrorType := ET_QUOTATION_MARK_EXPECTED;
                  FClue := WideChar(QuoteCode);
                  Exit;
                end;
                FInputSource.Next;

              end;
            CAPITAL_S_CODE: // 'S' --> 'SYSTEM' found.
              begin
                FInputSource.Next;
                FTokenStart := FInputSource.CurrentCharInfo;
                for I := 0 to 4 do
                  if FInputSource.NextCharInfo.CodePoint = SYSTEM_ID_START[I] then begin
                    FInputSource.Next;
                  end else begin
                    FTokenEnd := FInputSource.CurrentCharInfo;
                    FErrorType := ET_SYSTEM_KEYWORD_EXPECTED;
                    FClue := 'SYSTEM';
                    Exit;
                  end;
                FTokenType := DOCTYPE_PUBID_TOKEN;
                Self.Next;
              end;
            LS_BRACKET_CODE: // '[' found.
              begin
                FTokenType := DOCTYPE_SYSID_TOKEN;
                Self.Next;
              end;
          else
            FInputSource.Next;
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_SYSTEM_KEYWORD_EXPECTED;
            FClue := 'SYSTEM';
          end; {case ...}

        end;

      DOCTYPE_PUBID_TOKEN:
        begin
          FTokenType := DOCTYPE_SYSID_TOKEN;
          FTokenStart := FInputSource.NextCharInfo;

          // Check for whitespace:
          if not IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) then begin
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_MISSING_WHITE_SPACE;
            FClue := ' ';
            Exit;
          end;

          // Skip whitespace:
          FInputSource.Next;
          while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do
            FInputSource.Next;

          FTokenStart := FInputSource.NextCharInfo;

          // Find system identifier:
          if not (FInputSource.NextCharInfo.CodePoint in [DQ_CODE, SQ_CODE]) then begin
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_QUOTATION_MARK_EXPECTED;
            FClue := '"';
            Exit;
          end;
          FInputSource.Next;
          QuoteCode := FInputSource.CurrentCharInfo.CodePoint;
          while not (FInputSource.NextCharInfo.CodePoint in [QuoteCode, STRING_TERMINATOR_CODE]) do begin
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          end;
          FTokenEnd := FInputSource.CurrentCharInfo;
          if FInputSource.NextCharInfo.CodePoint <> QuoteCode then begin
            FErrorType := ET_QUOTATION_MARK_EXPECTED;
            FClue := WideChar(QuoteCode);
            Exit;
          end;
          FInputSource.Next;
        end;

      DOCTYPE_START_OF_SOURCE_TOKEN:
        begin
          FTokenType := DOCTYPE_NAME_TOKEN;

          // Check for leading whitespace:
          FInputSource.Next;
          FTokenStart := FInputSource.CurrentCharInfo;
          if not IsXmlWhiteSpaceCodePoint(FInputSource.CurrentCharInfo.CodePoint) then begin
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_MISSING_WHITE_SPACE;
            FClue := ' ';
            Exit;
          end;

          // Skip whitespace:
          while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do
            FInputSource.Next;

          // Find doctype name:
          DoctypeNameStart := True;
          FTokenStart := FInputSource.NextCharInfo;
          while not ( IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) or
                      (FInputSource.NextCharInfo.CodePoint = LS_BRACKET_CODE) or // ['
                      (FInputSource.NextCharInfo.CodePoint = GT_CODE) or         // '>'
                      (FInputSource.NextCharInfo.CodePoint = STRING_TERMINATOR_CODE) ) do begin
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            if DoctypeNameStart then begin
              DoctypeNameStart := False;
            end;
          end;
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

      DOCTYPE_SYSID_TOKEN:
        begin
          // Skip optional whitespace:
          while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do
            FInputSource.Next;

          case FInputSource.NextCharInfo.CodePoint of
            STRING_TERMINATOR_CODE:
              begin
                FInputSource.Next;
                FTokenEnd := FInputSource.PreviousCharInfo;
                FTokenType := DOCTYPE_END_OF_SOURCE_TOKEN;
              end;
            LS_BRACKET_CODE: // '[' found.
              begin
                FTokenType := DOCTYPE_INTSUBSET_TOKEN;
                FInputSource.Next;
                FTokenStart := FInputSource.NextCharInfo;
                LT_Found := False;
                EM_Found := False;
                CommentStartFound := False;
                CommentEndFound := False;
                InComment := False;
                InPI := False;
                DQ_Open := False;
                SQ_Open := False;
                while FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
                  FInputSource.Next;
                  if CommentEndFound then begin
                    CommentEndFound := False;
                    InComment := False;
                    if FInputSource.NextCharInfo.CodePoint <> GT_Code then begin
                      FTokenEnd := FInputSource.CurrentCharInfo;
                      FErrorType := ET_UNCLOSED_COMMENT;
                      FClue := '-->';
                      Exit;
                    end;
                  end;
                  if InComment then begin
                    if (FInputSource.CurrentCharInfo.CodePoint = HYPHEN_Code) and
                      (FInputSource.NextCharInfo.CodePoint = HYPHEN_Code) then
                      CommentEndFound := True;
                  end;
                  if InPI then begin
                    if (FInputSource.CurrentCharInfo.CodePoint = QM_Code) and
                      (FInputSource.NextCharInfo.CodePoint = GT_Code) then
                      InPI := False;
                  end;
                  if CommentStartFound then begin
                    CommentStartFound := False;
                    if FInputSource.CurrentCharInfo.CodePoint = HYPHEN_CODE then
                      InComment := True;
                  end;
                  if EM_Found then begin
                    EM_Found := False;
                    if FInputSource.CurrentCharInfo.CodePoint = HYPHEN_CODE then
                      CommentStartFound := True;
                  end;
                  if LT_Found then begin
                    LT_Found := False;
                    case FInputSource.CurrentCharInfo.CodePoint of
                      QM_CODE:
                        InPI := True;
                      EM_CODE:
                        EM_Found := True;
                    end;
                  end;
                  if DQ_Open then begin
                    DQ_Open := FInputSource.CurrentCharInfo.CodePoint <> DQ_CODE;
                  end else if SQ_Open then begin
                    SQ_Open := FInputSource.CurrentCharInfo.CodePoint <> SQ_CODE;
                  end else if not (InPI or InComment) then begin
                    case FInputSource.CurrentCharInfo.CodePoint of
                      LT_CODE:         // '<'
                        if not (InPI or InComment) then
                          LT_Found := True;
                      DQ_CODE:         // '"'
                        DQ_Open := True;
                      SQ_CODE:         // '''
                        SQ_Open := True;
                      RS_BRACKET_CODE: // ']'
                        begin
                          FTokenEnd := FInputSource.PreviousCharInfo;
                          Exit;
                        end;
                    end;
                  end;
                  FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
                end;

                if FInputSource.NextCharInfo.CodePoint <> RS_BRACKET_CODE then begin
                  FTokenEnd := FInputSource.CurrentCharInfo;
                  FErrorType := ET_RIGHT_SQUARE_BRACKET_EXPECTED;
                  FClue := ']';
                  Exit;
                end;
                FInputSource.Next;
              end;
          else
            FInputSource.Next;
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_LEFT_SQUARE_BRACKET_EXPECTED;
            FClue := '[';
          end; {case ...}
        end;
    end;

  except
    on EConvertError do begin
      FTokenEnd := FInputSource.CurrentCharInfo;
      FErrorType := ET_INVALID_CHARACTER;
    end;
  end; {try ...}
end;



{ TXmlDtdDetailTokenizer }

constructor TXmlDtdDetailTokenizer.Create(const InputSource: TXmlSimpleInputSource;
                                          const AIsPERefInDeclSep: Boolean);    
begin
  inherited Create(InputSource);
  FInPI := False;
  FIsPERefInDeclSep := AIsPERefInDeclSep;
  FLastTokenType := DTD_DETAIL_START_OF_SOURCE_TOKEN;
  FErrorType := ET_NONE;
  if Assigned(InputSource) then
    FTokenType := DTD_DETAIL_START_OF_SOURCE_TOKEN
  else
    FTokenType := DTD_DETAIL_END_OF_SOURCE_TOKEN;
end;

procedure TXmlDtdDetailTokenizer.Next;
const
  EM_CODE              = $21; // code of !
  DQ_CODE              = $22; // code of "
  PERCENT_CODE         = $25; // code of %
  SQ_CODE              = $27; // code of '
  OPENING_BRACKET_CODE = $28; // code of (
  CLOSING_BRACKET_CODE = $29; // code of )
  ASTERISK_CODE        = $2A; // code of *
  PLUS_SIGN_CODE       = $2B; // code of +
  COMMA_CODE           = $2C; // code of ,
  HYPHEN_CODE          = $2D; // code of -
  COLON_CODE           = $3A; // code of :
  SEMICOLON_CODE       = $3B; // code of ;
  LOW_LINE_CODE        = $5F; // code of _
  LT_CODE              = $3C; // code of <
  GT_CODE              = $3E; // code of >
  QM_CODE              = $3F; // code of ?
  CAPITAL_A_CODE       = $41; // code of A
  CAPITAL_E_CODE       = $45; // code of E
  CAPITAL_L_CODE       = $4C; // code of L
  CAPITAL_N_CODE       = $4E; // code of N
  LS_BRACKET_CODE      = $5B; // code of [
  RS_BRACKET_CODE      = $5D; // code of ]
  VERTICAL_LINE_CODE   = $7C; // code of |

  STRING_TERMINATOR_CODE = $9C;

  ENTITY_DECL_START: array[0..3] of UCS4Char =
    (Ord('T'), Ord('I'), Ord('T'), Ord('Y'));
  ELEMENT_DECL_START: array[0..4] of UCS4Char =
    (Ord('E'), Ord('M'), Ord('E'), Ord('N'), Ord('T'));
  ATTLIST_DECL_START: array[0..5] of UCS4Char =
    (Ord('T'), Ord('T'), Ord('L'), Ord('I'), Ord('S'), Ord('T'));
  NOTATION_DECL_START: array[0..6] of UCS4Char =
    (Ord('O'), Ord('T'), Ord('A'), Ord('T'), Ord('I'), Ord('O'), Ord('N'));
var
  I: Integer;
  QuoteCode: UCS4Char;
begin
  if FTokenType = DTD_DETAIL_END_OF_SOURCE_TOKEN then Exit;

  FTokenValue.Clear;
  FTokenType := DTD_DETAIL_INVALID_MARKUP_TOKEN;
  FErrorType := ET_NONE;
  FClue := '';
  FTokenStart := FInputSource.NextCharInfo;

  try
    FInputSource.Next;

    if FInPI then begin

      if FInputSource.CurrentCharInfo.CodePoint = STRING_TERMINATOR_CODE then begin

        // End of source found:
        FTokenType := DTD_DETAIL_END_OF_SOURCE_TOKEN;
        FTokenEnd := FInputSource.CurrentCharInfo;
        FErrorType := ET_UNCLOSED_PROCESSING_INSTRUCTION;
        FInPI := False;

      end else
      if IsXmlWhiteSpaceCodePoint(FInputSource.CurrentCharInfo.CodePoint) then begin

        // Whitespace found:
        FTokenType := DTD_DETAIL_WHITESPACE_TOKEN;
        FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
        while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do begin
          FInputSource.Next;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
        end;
        FTokenEnd := FInputSource.CurrentCharInfo;

      end else begin

        // Processing Instruction content found:
        FTokenType := DTD_DETAIL_PI_CONTENT_TOKEN;
        while FInputSource.CurrentCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
          if (FInputSource.CurrentCharInfo.CodePoint = QM_CODE) and
             (FInputSource.NextCharInfo.CodePoint = GT_CODE)
          then begin
            // '?>' found:
            FTokenEnd := FInputSource.PreviousCharInfo;
            FInputSource.Next;
            FInPI := False;
            Exit;
          end;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          FInputSource.Next;
        end;
        FTokenEnd := FInputSource.CurrentCharInfo;
        FErrorType := ET_UNCLOSED_PROCESSING_INSTRUCTION;
        FClue := '?';
        FInPI := False;

      end;

    end else begin
      case FInputSource.CurrentCharInfo.CodePoint of

        // '<' found:
        LT_CODE: begin
          case FInputSource.NextCharInfo.CodePoint of

            // '?' --> Processing Instruction found:
            QM_CODE: begin
              FInputSource.Next;
              FTokenType := DTD_DETAIL_PI_TARGET_TOKEN;
              FTokenStart := FInputSource.NextCharInfo;
              while not ( ( FInputSource.NextCharInfo.CodePoint in
                             [ PERCENT_CODE, LT_CODE, GT_CODE, OPENING_BRACKET_CODE,
                               CLOSING_BRACKET_CODE, VERTICAL_LINE_CODE, COMMA_CODE,
                               DQ_CODE, SQ_CODE, RS_BRACKET_CODE, LS_BRACKET_CODE,
                               QM_CODE, STRING_TERMINATOR_CODE ] ) or
                          IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) ) do begin
                FInputSource.Next;
                FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
              end;
              FTokenEnd := FInputSource.CurrentCharInfo;
              FInPI := True;
            end;

            // '!' --> Markup declaration found:
            EM_CODE: begin
              FInputSource.Next;
              case FInputSource.NextCharInfo.CodePoint of

                HYPHEN_CODE: begin // '-' --> Comment found:
                  FTokenType := DTD_DETAIL_COMMENT_TOKEN;
                  FInputSource.Next;
                  if FInputSource.NextCharInfo.CodePoint = HYPHEN_CODE then begin // '<!--' found:
                    FInputSource.Next;
                    FTokenStart := FInputSource.NextCharInfo;
                    while FInputSource.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
                      FInputSource.Next;
                      if FInputSource.CurrentCharInfo.CodePoint = HYPHEN_CODE then begin // '-' found
                        FTokenEnd := FInputSource.PreviousCharInfo;
                        FInputSource.Next;
                        case FInputSource.CurrentCharInfo.CodePoint of
                          HYPHEN_CODE: begin // Second '-'
                            if FInputSource.NextCharInfo.CodePoint = GT_CODE then begin// '>'?
                              FInputSource.Next;
                            end else begin
                              FTokenEnd := FInputSource.CurrentCharInfo;
                              FErrorType := ET_DOUBLE_HYPHEN_IN_COMMENT;
                              FClue := '>';
                            end;
                            Exit;
                          end;
                          STRING_TERMINATOR_CODE: begin
                            FTokenEnd := FInputSource.PreviousCharInfo;
                            FErrorType := ET_UNCLOSED_COMMENT;
                            FClue := '-->';
                            Exit;
                          end;
                        else
                          // No second '-' --> Add '-' to content of comment:
                          FTokenValue.AddUCS4Char(HYPHEN_CODE);
                        end;
                      end;
                      FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
                    end;
                    FTokenEnd := FInputSource.CurrentCharInfo;
                    FErrorType := ET_UNCLOSED_COMMENT;
                    FClue := '-->';
                    Exit;
                  end;
                  FTokenEnd := FInputSource.CurrentCharInfo;
                  FErrorType := ET_COMMENT_START_EXPECTED;
                  FClue := '<!--';
                end;

                LS_BRACKET_CODE: begin // '[' --> Conditional Section found:
                  FTokenType := DTD_DETAIL_COND_SECT_START_TOKEN;
                  FInputSource.Next;
                  FTokenEnd := FInputSource.CurrentCharInfo;
                end;

              else // --> Element, Entity, Attlist or Notation Declaration found:
                case FInputSource.NextCharInfo.CodePoint of
                  CAPITAL_E_CODE: begin // 'E' --> Element or Entity Declaration found:
                    FInputSource.Next;
                    case FInputSource.NextCharInfo.CodePoint of

                      CAPITAL_L_CODE: begin // 'L' --> Element Declaration found:
                        FTokenType := DTD_DETAIL_ELEMENT_DECL_START_TOKEN;
                        FInputSource.Next;
                        for I := 0 to 4 do
                          if FInputSource.NextCharInfo.CodePoint = ELEMENT_DECL_START[I] then begin
                            FInputSource.Next;
                          end else begin
                            FTokenEnd := FInputSource.CurrentCharInfo;
                            FErrorType := ET_ELEMENT_DECL_START_EXPECTED;
                            FClue := '<!ELEMENT';
                            Exit;
                          end;
                      end;

                      CAPITAL_N_CODE: begin // 'N' --> Entity Declaration found:
                        FTokenType := DTD_DETAIL_ENTITY_DECL_START_TOKEN;
                        FInputSource.Next;
                        for I := 0 to 3 do
                          if FInputSource.NextCharInfo.CodePoint = ENTITY_DECL_START[I] then begin
                            FInputSource.Next;
                          end else begin
                            FTokenEnd := FInputSource.CurrentCharInfo;
                            FErrorType := ET_ENTITY_DECL_START_EXPECTED;
                            FClue := '<!ENTITY';
                            Exit;
                          end;
                      end;

                    else
                      FTokenEnd := FInputSource.CurrentCharInfo;
                      FErrorType := ET_INVALID_MARKUP_DECL;
                      Exit;
                    end;
                  end;

                  CAPITAL_A_CODE: begin // 'A' --> Attribute List Declaration found:
                    FTokenType := DTD_DETAIL_ATTLIST_DECL_START_TOKEN;
                    FInputSource.Next;
                    for I := 0 to 5 do
                      if FInputSource.NextCharInfo.CodePoint = ATTLIST_DECL_START[I] then begin
                        FInputSource.Next;
                      end else begin
                        FTokenEnd := FInputSource.CurrentCharInfo;
                        FErrorType := ET_ATTLIST_DECL_START_EXPECTED;
                        FClue := '<!ATTLIST';
                        Exit;
                      end;
                  end;

                  CAPITAL_N_CODE: begin // 'N' --> Notation Declaration found:
                    FTokenType := DTD_DETAIL_NOTATION_DECL_START_TOKEN;
                    FInputSource.Next;
                    for I := 0 to 6 do
                      if FInputSource.NextCharInfo.CodePoint = NOTATION_DECL_START[I] then begin
                        FInputSource.Next;
                      end else begin
                        FTokenEnd := FInputSource.CurrentCharInfo;
                        FErrorType := ET_NOTATION_DECL_START_EXPECTED;
                        FClue := '<!NOTATION';
                        Exit;
                      end;
                  end;
                else
                  FTokenEnd := FInputSource.CurrentCharInfo;
                  FErrorType := ET_INVALID_MARKUP_DECL;
                  Exit;
                end;

              end;
            end; {EM_CODE:}

          else
            FTokenEnd := FInputSource.CurrentCharInfo;
            FErrorType := ET_INVALID_MARKUP_DECL;
            FClue := '<!';
          end;
        end;

        LS_BRACKET_CODE: begin
          FTokenType := DTD_DETAIL_COND_SECT_OPENER_TOKEN;
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

        // End of markup declaration found:
        GT_CODE: begin
          FTokenType := DTD_DETAIL_DECL_END_TOKEN;
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

        // End of Conditional Section found:
        RS_BRACKET_CODE: begin
          FTokenType := DTD_DETAIL_COND_SECT_END_TOKEN;
          if FInputSource.NextCharInfo.CodePoint = RS_BRACKET_CODE then begin // ']'
            FInputSource.Next;
            if FInputSource.NextCharInfo.CodePoint = GT_CODE then begin // '>'
              FTokenStart := FInputSource.NextCharInfo;
              FInputSource.Next;
            end else begin
              FErrorType := ET_INVALID_CHARACTER;
              FClue := ']]>';
            end;
          end else begin
            FErrorType := ET_INVALID_CHARACTER;
            FClue := ']]>';
          end;
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

        // Quoted string found:
        DQ_CODE, SQ_CODE: begin
          FTokenType := DTD_DETAIL_QUOTED_STRING_TOKEN;
          QuoteCode := FInputSource.CurrentCharInfo.CodePoint;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          while FInputSource.NextCharInfo.CodePoint <> QuoteCode do begin
            if FInputSource.NextCharInfo.CodePoint = STRING_TERMINATOR_CODE then begin
              FTokenEnd := FInputSource.CurrentCharInfo;
              FErrorType := ET_QUOTATION_MARK_EXPECTED;
              FClue := WideChar(QuoteCode);
              Exit;
            end;
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          end;
          FInputSource.Next;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

        OPENING_BRACKET_CODE, VERTICAL_LINE_CODE, COMMA_CODE: begin
          FTokenType := DTD_DETAIL_OPERATOR_TOKEN;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

        CLOSING_BRACKET_CODE: begin
          FTokenType := DTD_DETAIL_OPERATOR_TOKEN;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          if FInputSource.NextCharInfo.CodePoint in [ASTERISK_CODE, PLUS_SIGN_CODE, QM_CODE] then begin
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          end;
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

        // End of source found:
        STRING_TERMINATOR_CODE: begin
          FTokenType := DTD_DETAIL_END_OF_SOURCE_TOKEN;
          FTokenEnd := FInputSource.CurrentCharInfo;
        end;

      else

        if IsXmlWhiteSpaceCodePoint(FInputSource.CurrentCharInfo.CodePoint) then begin

          // Whitespace found:
          FTokenType := DTD_DETAIL_WHITESPACE_TOKEN;
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          while IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) do begin
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          end;

        end else begin

          if FInputSource.CurrentCharInfo.CodePoint = PERCENT_CODE
            then FTokenType := DTD_DETAIL_KEYWORD_TOKEN // Keyword (or parameter reference) found.
            else FTokenType := DTD_DETAIL_UNQUOTED_STRING_TOKEN;  // Unquoted string found.
          FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
          while not ( ( FInputSource.NextCharInfo.CodePoint in
                         [ PERCENT_CODE, LT_CODE, GT_CODE, OPENING_BRACKET_CODE,
                           CLOSING_BRACKET_CODE, VERTICAL_LINE_CODE, COMMA_CODE,
                           DQ_CODE, SQ_CODE, RS_BRACKET_CODE, LS_BRACKET_CODE,
                           STRING_TERMINATOR_CODE ] ) or
                      IsXmlWhiteSpaceCodePoint(FInputSource.NextCharInfo.CodePoint) ) do begin
            FInputSource.Next;
            FTokenValue.AddUCS4Char(FInputSource.CurrentCharInfo.CodePoint);
            if FInputSource.CurrentCharInfo.CodePoint = SEMICOLON_CODE then
              Break;
          end;

        end;
        FTokenEnd := FInputSource.CurrentCharInfo;

      end;

   end; {if ... else ...}

  except
    on EConvertError do
    begin
      FTokenEnd := FInputSource.CurrentCharInfo;
      FErrorType := ET_INVALID_CHARACTER;
    end;
  end; {try ...}
end;

procedure TXmlDtdDetailTokenizer.NextEndOfIgnoredCondSect;
const
  EM_CODE          = $21; // code of !
  LT_CODE          = $3C; // code of <
  GT_CODE          = $3E; // code of >
  LS_BRACKET_CODE  = $5B; // code of [
  RS_BRACKET_CODE  = $5D; // code of ]
  STRING_TERMINATOR_CODE = $9C;
var
  N: Integer;
begin
  if FTokenType = DTD_DETAIL_END_OF_SOURCE_TOKEN then Exit;

  FTokenValue.Clear;
  FTokenType := DTD_DETAIL_INVALID_MARKUP_TOKEN;
  FErrorType := ET_NONE;
  FClue := '';
  N := 0;

  try

    while FTokenType = DTD_DETAIL_INVALID_MARKUP_TOKEN do begin

      FInputSource.Next;

      case FInputSource.CurrentCharInfo.CodePoint of

        // '<' found:
        LT_CODE:
          if FInputSource.NextCharInfo.CodePoint = EM_CODE then begin // '!' found?
            FInputSource.Next;
            if FInputSource.NextCharInfo.CodePoint = LS_BRACKET_CODE then begin
              // '<![' --> Conditional section start found:
              FInputSource.Next;
              Inc(N);
            end;
          end;

        // ']' found:
        RS_BRACKET_CODE:
          if FInputSource.NextCharInfo.CodePoint = RS_BRACKET_CODE then begin // ']' found?
            FInputSource.Next;
            while FInputSource.NextCharInfo.CodePoint = RS_BRACKET_CODE do // more ']'?
              FInputSource.Next;
            if FInputSource.NextCharInfo.CodePoint = GT_CODE then begin
              // ']]>' --> Conditional section end found:
              FInputSource.Next;
              if N = 0
                then FTokenType := DTD_DETAIL_COND_SECT_END_TOKEN
                else Dec(N);
            end;
          end;

        // End of source found:
        STRING_TERMINATOR_CODE:
          FTokenType := DTD_DETAIL_END_OF_SOURCE_TOKEN;
      end;

    end; {while ...}
  except
    on EConvertError do
      FErrorType := ET_INVALID_CHARACTER;
  end; {try ...}
end;



{ TXmlDtdDetailPETokenizer }

constructor TXmlDtdDetailPETokenizer.Create(const AInputSource: TXmlSimpleInputSource;
                                            const AIsPERefInDeclSep: Boolean);
begin
  if not Assigned(AInputSource) then
    raise ENot_Supported_Err.Create('Not supported error.');
  inherited Create;
  FPERefTreatment := petResolve;
  FIsInMarkup := False;
  FBufSize := AInputSource.BufSize;
  FTokenizerStack   := TObjectStack.Create;
  FInputSourceStack := TObjectStack.Create;
  FStreamStack      := TObjectStack.Create;
  FPENameStack      := TUtilsWideStringList.Create;
  FPENameStack.Duplicates := dupAccept;
  FPENameStack.Sorted := False;
  FErrorType := ET_NONE;

  FStreamStack.Push(nil);
  FInputSourceStack.Push(nil);
  CreateInternalTokenizer(AInputSource, '', AIsPERefInDeclSep);
end;

procedure TXmlDtdDetailPETokenizer.CreateInternalInputSource(const Stream: TStream;
                                                             const PEName,
                                                                   PubId,
                                                                   SysId: WideString;
                                                             const CodecClass: TUnicodeCodecClass;
                                                             const IsPERefInDeclSep: Boolean);
var
  XmlInputSource: TXmlSimpleInputSource;
begin
  XmlInputSource := TXmlSimpleInputSource.Create(Stream, PubId, SysId, FBufSize,
                                   CodecClass, 0, 0, 0, 0, 0); 
  try
    CreateInternalTokenizer(XmlInputSource, PEName, IsPERefInDeclSep);
    FInputSourceStack.Push(XmlInputSource);
  except
    XmlInputSource.Free;
    raise;
  end;
end;

procedure TXmlDtdDetailPETokenizer.CreateInternalStream(const S,
                                                              PEName,
                                                              PubId,
                                                              SysId: WideString;
                                                        const IsPERefInDeclSep: Boolean);
var
  Stream: TUtilsWideStringStream;
begin
  Stream := TUtilsWideStringStream.Create(S);
  try
    CreateInternalInputSource(Stream, PEName, PubId, SysId, TUTF16LECodec, IsPERefInDeclSep);
    FStreamStack.Push(Stream);
  except
    Stream.Free;
    raise;
  end;
end;

procedure TXmlDtdDetailPETokenizer.CreateInternalTokenizer(const InputSource: TXmlSimpleInputSource;
                                                           const PEName: WideString;
                                                           const IsPERefInDeclSep: Boolean);
begin
  FTokenizerStack.Push(TXmlDtdDetailTokenizer.Create(InputSource, IsPERefInDeclSep));
  FPENameStack.Append(PEName);
end;

destructor TXmlDtdDetailPETokenizer.Destroy;
begin
  while FTokenizerStack.Count > 0 do
    DestroyInternalTokenizer;
  FPENameStack.Free;
  FStreamStack.Free;
  FInputSourceStack.Free;
  FTokenizerStack.Free;
  inherited;
end;

procedure TXmlDtdDetailPETokenizer.DestroyInternalTokenizer;
begin
  TXmlDtdDetailTokenizer(FTokenizerStack.Pop).Free;
  TXmlSimpleInputSource(FInputSourceStack.Pop).Free;
  TUtilsWideStringStream(FStreamStack.Pop).Free;
  FPENameStack.Delete(Pred(FPENameStack.Count));     
end;

procedure TXmlDtdDetailPETokenizer.DoResolveParameterEntity(const EntityName: WideString;
                                                              out EntityValue,
                                                                  PubId,
                                                                  SysId: WideString;
                                                              out Error: TXmlErrorType);
begin
  EntityValue := '';
  PubId := '';
  SysId := '';
  Error := ET_UNDEFINED_PARAMETER_ENTITY;
  if Assigned(FOnResolveParameterEntity) then
    FOnResolveParameterEntity(Self, EntityName, EntityValue, PubId, SysId, Error);
end;

function TXmlDtdDetailPETokenizer.GetClue: WideString;
begin
  Result := InternalTokenizer.Clue;
end;

function TXmlDtdDetailPETokenizer.GetCurrentPEName: WideString;
begin
  Result := FPENameStack[Pred(FPENameStack.Count)];
end;

function TXmlDtdDetailPETokenizer.GetEndByteNumber: Int64;
begin
  Result := InternalTokenizer.GetEndByteNumber;
end;

function TXmlDtdDetailPETokenizer.GetEndCharNumber: Int64;
begin
  Result := InternalTokenizer.GetEndCharNumber;
end;

function TXmlDtdDetailPETokenizer.GetEndColumnNumber: Int64;
begin
  Result := InternalTokenizer.GetEndColumnNumber;
end;

function TXmlDtdDetailPETokenizer.GetEndLineNumber: Int64;
begin
  Result := InternalTokenizer.GetEndLineNumber;
end;

function TXmlDtdDetailPETokenizer.GetEndTabsInLine: Int64;
begin
  Result := InternalTokenizer.GetEndTabsInLine;
end;

function TXmlDtdDetailPETokenizer.GetErrorType: TXmlErrorType;
begin
  if FErrorType in ET_WARNINGS
    then Result := InternalTokenizer.ErrorType
    else Result := FErrorType;
  // Remark: FErrorType indicates an error when attempting to resolve a
  //         parameter entity reference.
end;

function TXmlDtdDetailPETokenizer.GetInternalTokenizer: TXmlDtdDetailTokenizer;
begin
  Result := TXmlDtdDetailTokenizer(FTokenizerStack.Peek);
end;

function TXmlDtdDetailPETokenizer.GetIsPERefInDeclSep: Boolean;
begin
  Result := InternalTokenizer.IsPERefInDeclSep;
end;

function TXmlDtdDetailPETokenizer.GetIsProcessingPE: Boolean;
begin
  Result := FTokenizerStack.Count > 1;
end;

function TXmlDtdDetailPETokenizer.GetRelatedDtdObject: TDtdObject;
begin
  Result := InternalTokenizer.GetRelatedDtdObject;
end;

function TXmlDtdDetailPETokenizer.GetRelatedNode: TDomNode;
begin
  Result := InternalTokenizer.GetRelatedNode;
end;

function TXmlDtdDetailPETokenizer.GetStartByteNumber: Int64;
begin
  Result := InternalTokenizer.GetStartByteNumber;
end;

function TXmlDtdDetailPETokenizer.GetStartCharNumber: Int64;
begin
  Result := InternalTokenizer.GetStartCharNumber;
end;

function TXmlDtdDetailPETokenizer.GetStartColumnNumber: Int64;
begin
  Result := InternalTokenizer.GetStartColumnNumber;
end;

function TXmlDtdDetailPETokenizer.GetStartLineNumber: Int64;
begin
  Result := InternalTokenizer.GetStartLineNumber;
end;

function TXmlDtdDetailPETokenizer.GetStartTabsInLine: Int64;
begin
  Result := InternalTokenizer.GetStartTabsInLine;
end;

function TXmlDtdDetailPETokenizer.GetTokenType: TXmlDtdDetailTokenType;
begin
  Result := InternalTokenizer.TokenType;
  if Result = DTD_DETAIL_KEYWORD_TOKEN then
    if IsXmlPEReference(TokenValue) then
      Result := DTD_DETAIL_PARAMETER_ENTITY_REF_TOKEN;
end;

function TXmlDtdDetailPETokenizer.GetTokenValue: WideString;
begin
  Result := InternalTokenizer.TokenValue;
end;

function TXmlDtdDetailPETokenizer.GetUri: WideString;
begin
  Result := InternalTokenizer.GetUri;
end;

procedure TXmlDtdDetailPETokenizer.Next;
var
  AbsoluteSystemId: WideString;
  PEName, PEValue, PEPubId, PESysId: WideString;
  S: WideString;
  Error: TXmlErrorType;
  LastTokenType: TXmlDtdDetailTokenType;
begin
  LastTokenType := TokenType;
  InternalTokenizer.Next;
  FErrorType := ET_NONE;

  // Parameter entity reference found?
  case TokenType of

    DTD_DETAIL_PARAMETER_ENTITY_REF_TOKEN:
      if IsInMarkup and not (PERefTreatment = petResolve) then begin
        FErrorType := ET_PARAMETER_ENTITY_REF_NOT_ALLOWED;
      end else begin

        // Resolve parameter entity reference:
        PEName := Copy(InternalTokenizer.TokenValue, 2, Length(InternalTokenizer.TokenValue) - 2);
        DoResolveParameterEntity(PEName, PEValue, PEPubId, PESysId, Error);

        if (Error in [ET_EXT_ENTITY_RESOURCE_NOT_FOUND, ET_UNDEFINED_PARAMETER_ENTITY]) and
           (PERefTreatment = petResolveInDeclSepSkipExt) then begin
          FErrorType := ET_NONE;  // Reference to an external parameter entity during wellformedness test.
        end else

        if Error in ET_WARNINGS then begin

          // Calculate absolute system identifier:
          ResolveRelativeUriWideStr(GetUri,
                                    PESysId,
                                    AbsoluteSystemId);  // Remark: Returns an empty AbsoluteSystemId
                                                        // if resolution attempt fails.

          // Process parameter entity:
          if LastTokenType in [ DTD_DETAIL_PARAMETER_ENTITY_REF_TOKEN, DTD_DETAIL_WHITESPACE_TOKEN ]
            then S := Concat(PEValue, WideString(#$0020))  // Remark: Suppress dublicate whitespace to make the evaluation easier.
            else S := Concat(WideString(#$0020), PEValue, WideString(#$0020)); // Add byte order mark.
          try
            CreateInternalStream(S, PEName, PEPubId, AbsoluteSystemId, not IsInMarkup);
          except
            FErrorType := ET_EXT_PARAMETER_ENTITY_RESOURCE_NOT_FOUND;
          end;

          if ErrorType in ET_WARNINGS then begin  // Remark: ErrorType must be used instead of FErrorType in order to
            Next;                                 //         test whether InternalTokenizer.ErrorType reports an error
          end;                                    //         detected in the previous call of CreateInternalStream.

        end else

          FErrorType := Error;

      end;

    DTD_DETAIL_ATTLIST_DECL_START_TOKEN,
    DTD_DETAIL_ELEMENT_DECL_START_TOKEN,
    DTD_DETAIL_ENTITY_DECL_START_TOKEN,
    DTD_DETAIL_NOTATION_DECL_START_TOKEN:
      FIsInMarkup := True;

    DTD_DETAIL_DECL_END_TOKEN:
      FIsInMarkup := False;

    DTD_DETAIL_END_OF_SOURCE_TOKEN:
      if FTokenizerStack.Count > 1 then begin
        if InternalTokenizer.IsPERefInDeclSep and FIsInMarkup then begin
          // WFC: PE Between Declaration (XML 1.0, § 2.8)
          FErrorType := ET_PE_BETWEEN_DECLARATIONS;
          DestroyInternalTokenizer;
        end else begin
          DestroyInternalTokenizer;
          Next;
        end;
      end;
  end;
end;

procedure TXmlDtdDetailPETokenizer.NextEndOfIgnoredCondSect;
begin
  InternalTokenizer.NextEndOfIgnoredCondSect;
end;

procedure TXmlDtdDetailPETokenizer.SetPERefTreatment(const Value: TXmlPERefTreatment);
begin
  FPERefTreatment := Value;
end;



{ TXmlCustomSubsetTokenizer }

constructor TXmlCustomSubsetTokenizer.Create(const AInputSource: TXmlSimpleInputSource;
                                             const APERepository: TDomPERepository);
begin
  if not Assigned(AInputSource) then
    raise ENot_Supported_Err.Create('Not supported error.');
  if not Assigned(APERepository) then
    raise ENot_Supported_Err.Create('Not supported error.');
  inherited Create;

  FAllowConditionalSections := True;
  FCondSectBracketPEName := TUtilsWideStringList.Create;
  FCondSectBracketPEName.Duplicates := dupAccept;
  FCondSectBracketPEName.Sorted := False;
  FCondSectStartPEName := TUtilsWideStringList.Create;
  FCondSectStartPEName.Duplicates := dupAccept;
  FCondSectStartPEName.Sorted := False;

  FOpeningBracketPEName := TUtilsWideStringList.Create;
  FOpeningBracketPEName.Duplicates := dupAccept;
  FOpeningBracketPEName.Sorted := False;

  FCurrentSignal := nil;

  FPERepository := APERepository;

  FXmlDtdDetailPETokenizer := TXmlDtdDetailPETokenizer.Create(AInputSource, False);
  FXmlDtdDetailPETokenizer.OnResolveParameterEntity := ResolveParameterEntityEventHandler;
  if FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_START_OF_SOURCE_TOKEN
    then FTokenType := DTD_ABSTRACT_START_OF_SOURCE_TOKEN
    else FTokenType := DTD_ABSTRACT_END_OF_SOURCE_TOKEN;
  FErrorType := FXmlDtdDetailPETokenizer.ErrorType;  // Value depents on wellformedness of the XML declaration (if any).
end;

destructor TXmlCustomSubsetTokenizer.Destroy;
begin
  FCurrentSignal.Free;
  FXmlDtdDetailPETokenizer.Free;
  FOpeningBracketPEName.Free;
  FCondSectBracketPEName.Free;
  FCondSectStartPEName.Free;
  inherited;
end;

function TXmlCustomSubsetTokenizer.CreateCommentSignal(const Data: WideString): TXmlCommentSignal;
begin
  Result := TXmlCommentSignal.CreateFromLocator(nil, Self);
  try
    Result.Data := Data;
  except
    Result.Free;
    raise;
  end;
end;

function TXmlCustomSubsetTokenizer.CreateElementDeclSignal(const ElementName,
                                                                 Data: WideString;
                                                           const IsDeclaredInPE: Boolean): TXmlElementTypeDeclarationSignal;
begin
  Result := TXmlElementTypeDeclarationSignal.CreateFromLocator(nil, Self);
  try
    Result.ElementName := ElementName;
    Result.Data := Data;
    Result.IsDeclaredInPE := IsDeclaredInPE;
  except
    Result.Free;
    raise;
  end;
end;

function TXmlCustomSubsetTokenizer.CreateEntityDeclSignal(const EntityName,
                                                                EntityValue,
                                                                PublicId,
                                                                SystemId,
                                                                NotationName,
                                                                BaseUri: WideString;
                                                          const IsDeclaredInPE: Boolean): TXmlEntityDeclarationSignal;
begin
  Result := TXmlEntityDeclarationSignal.CreateFromLocator(nil, Self);
  try
    Result.BaseUri := BaseUri;
    Result.EntityName := EntityName;
    Result.EntityValue := EntityValue;
    Result.PublicId := PublicId;
    Result.SystemId := SystemId;
    Result.NotationName := NotationName;
    Result.IsDeclaredInPE := IsDeclaredInPE;
  except
    Result.Free;
    raise;
  end;
end;

function TXmlCustomSubsetTokenizer.CreateExtPERefSignal(const ParameterEntityReference: WideString): TXmlExternalPEReferenceSignal;
begin
  Result := TXmlExternalPEReferenceSignal.CreateFromLocator(nil, Self);
  try
    Result.ParameterEntityName := Copy(ParameterEntityReference, 2, Length(ParameterEntityReference) - 2);
  except
    Result.Free;
    raise;
  end;
end;

function TXmlCustomSubsetTokenizer.CreateParameterEntityDeclSignal(const EntityName,
                                                                         EntityValue,
                                                                         PublicId,
                                                                         SystemId,
                                                                         BaseUri: WideString): TXmlParameterEntityDeclarationSignal;
begin
  Result := TXmlParameterEntityDeclarationSignal.CreateFromLocator(nil, Self);
  try
      Result.BaseUri := BaseUri;
      Result.EntityName := EntityName;
      Result.EntityValue := EntityValue;
      Result.PublicId := PublicId;
      Result.SystemId := SystemId;
  except
    Result.Free;
    raise;
  end;
end;

function TXmlCustomSubsetTokenizer.CreatePISignal(const Target,
                                                        Data: WideString): TXmlProcessingInstructionSignal;
begin
  Result := TXmlProcessingInstructionSignal.CreateFromLocator(nil, Self);
  try
    Result.Target := Target;
    Result.Data := Data;
  except
    Result.Free;
    raise;
  end;
end;

function TXmlCustomSubsetTokenizer.CreateNotationDeclSignal(const NotationName,
                                                                  PubidLiteral,
                                                                  SystemLiteral: WideString;
                                                            const IsDeclaredInPE: Boolean): TXmlNotationDeclarationSignal;
begin
  Result := TXmlNotationDeclarationSignal.CreateFromLocator(nil, Self);
  try
    Result.NotationName := NotationName;
    Result.PublicId := PubidLiteral;
    Result.SystemId := SystemLiteral;
    Result.IsDeclaredInPE := IsDeclaredInPE;
  except
    Result.Free;
    raise;
  end;
end;

procedure TXmlCustomSubsetTokenizer.DoPEReference;
begin
  if Assigned(FOnPEReference) then
    FOnPEReference(Self, Self);
end;

procedure TXmlCustomSubsetTokenizer.DoProcessingAttListDecl(const ElementType: WideString);
begin
  if Assigned(FOnProcessingAttListDecl) then
    FOnProcessingAttListDecl(Self, ElementType, Self);
end;

function TXmlCustomSubsetTokenizer.GetAllowPEsInMarkup: Boolean;
begin
  Result := FXmlDtdDetailPETokenizer.PERefTreatment = petResolve;
end;

function TXmlCustomSubsetTokenizer.GetClue: WideString;
begin
  Result := FClue;
end;

function TXmlCustomSubsetTokenizer.GetEntityDeclBaseUri: WideString;
begin
  if FTokenType in [ DTD_ABSTRACT_ENTITY_DECL_TOKEN,
                     DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN ]
    then Result := FEntityDeclBaseUri
    else Result := '';
end;

function TXmlCustomSubsetTokenizer.GetErrorType: TXmlErrorType;
begin
  Result := FErrorType;
end;

function TXmlCustomSubsetTokenizer.GetIsProcessingPE: Boolean;
begin
  Result := FXmlDtdDetailPETokenizer.IsProcessingPE;
end;

function TXmlCustomSubsetTokenizer.GetSystemId: WideString;
begin
  Result := FXmlDtdDetailPETokenizer.GetUri;
end;

function TXmlCustomSubsetTokenizer.GetTokenType: TXmlDtdAbstractTokenType;
begin
  Result := FTokenType;
end;

procedure TXmlCustomSubsetTokenizer.Next;
const
  DQ: WideChar    = #$0022; // Double Quote ('"')
  SPACE: WideChar = #$0020;
var
  Error: Boolean;
  BracketPEMisnested: Boolean;
  ErrorKind: TXmlErrorType;
  ElementName, EntityName, EntityValue, NotationName, PITarget, PIData: WideString;
  PEName, PubId, SysId: WideString;
  S, S1: WideString;
  AttrDefs, ElmtCont, NotationDefinition: TUtilsCustomWideStr;
begin
  FCurrentSignal.Free;
  FCurrentSignal := nil;

  if ProcessPendingAttrDef then
    Exit;

  FXmlDtdDetailPETokenizer.Next;

  if FXmlDtdDetailPETokenizer.ErrorType <> ET_NONE then begin
    FTokenType := DTD_ABSTRACT_INVALID_MARKUP_TOKEN;
    FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
    FClue := FXmlDtdDetailPETokenizer.Clue;
  end else begin
    Assert(FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_INVALID_MARKUP_TOKEN);
    Assert(FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_START_OF_SOURCE_TOKEN);
    FErrorType := ET_NONE;
    FClue := '';

    case FXmlDtdDetailPETokenizer.TokenType of

      DTD_DETAIL_ATTLIST_DECL_START_TOKEN: begin
        // Process attribute list declaration
        // ----------------------------------
        //
        // Attribute list declaration start:
        FTokenType := DTD_ABSTRACT_ATTLIST_DECL_TOKEN;
        FErrorType := ET_INVALID_ATTRIBUTE_DECL;
        PEName := FXmlDtdDetailPETokenizer.CurrentPEName;

        // Whitespace:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
          Exit;

        // Attribute list declaration name:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_UNQUOTED_STRING_TOKEN then
          Exit;

        FAttDeclElementType := FXmlDtdDetailPETokenizer.TokenValue;

        // Attribute definitions:
        AttrDefs := TUtilsCustomWideStr.Create;
        try
          repeat
            FXmlDtdDetailPETokenizer.Next;
            if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
              FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
              FClue := FXmlDtdDetailPETokenizer.Clue;
              Exit;
            end;
            if FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_DECL_END_TOKEN then begin
              FErrorType := ET_NONE;
              Break;
            end;
            AttrDefs.AddWideString(FXmlDtdDetailPETokenizer.TokenValue);
          until FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_END_OF_SOURCE_TOKEN;
          FPendingAttrDefs := AttrDefs.Value;
        finally
          AttrDefs.Free;
        end;

        // VC: Proper Declaration/PE Nesting (XML 1.0, § 2.8)
        if FXmlDtdDetailPETokenizer.CurrentPEName <> PEName then
          FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_DECL;

        if not IsXmlName(FAttDeclElementType) then
          FErrorType := ET_INVALID_ATTLIST_DECL_NAME;
          // Remark: This test is necessary here, because if no attribute
          //         definitions are encountered no further checks in a
          //         processor pipeline will be carried out.

        if not (FErrorType in ET_FATAL_ERRORS) then begin
          DoProcessingAttListDecl(FAttDeclElementType);
          if not ProcessPendingAttrDef then
            Next;
        end;

      end;

      DTD_DETAIL_COMMENT_TOKEN: begin
        // Process comment:
        FTokenType := DTD_ABSTRACT_COMMENT_TOKEN;
        FCurrentSignal := CreateCommentSignal(FXmlDtdDetailPETokenizer.TokenValue);
        FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
        FClue := FXmlDtdDetailPETokenizer.Clue;
      end;

      DTD_DETAIL_ELEMENT_DECL_START_TOKEN: begin
        // Process element type declaration:
        // ---------------------------------
        //
        // Element type declaration start:
        FTokenType := DTD_ABSTRACT_ELEMENT_DECL_TOKEN;
        FErrorType := ET_INVALID_ELEMENT_DECL;
        PEName := FXmlDtdDetailPETokenizer.CurrentPEName;

        // Whitespace:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
          Exit;

        // Element type declaration name:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_UNQUOTED_STRING_TOKEN then
          Exit;
        ElementName := FXmlDtdDetailPETokenizer.TokenValue;

        // Whitespace:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
          Exit;

        // Element content specification:
        FOpeningBracketPEName.Clear;
        BracketPEMisnested := False;
        ElmtCont := TUtilsCustomWideStr.Create;
        try
          repeat
            FXmlDtdDetailPETokenizer.Next;
            if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
              FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
              FClue := FXmlDtdDetailPETokenizer.Clue;
              Exit;
            end;
            case FXmlDtdDetailPETokenizer.TokenType of
              DTD_DETAIL_DECL_END_TOKEN: begin
                FErrorType := ET_NONE;
                Break;
              end;
              DTD_DETAIL_OPERATOR_TOKEN: begin
                if FXmlDtdDetailPETokenizer.TokenValue = '(' then begin
                  FOpeningBracketPEName.Append(FXmlDtdDetailPETokenizer.CurrentPEName);
                end else if FXmlDtdDetailPETokenizer.TokenValue[1] = ')' then begin
                  if FOpeningBracketPEName.Count > 0 then begin
                    if FOpeningBracketPEName[Pred(FOpeningBracketPEName.Count)] <> FXmlDtdDetailPETokenizer.CurrentPEName then
                      BracketPEMisnested := True;
                    FOpeningBracketPEName.Delete(Pred(FOpeningBracketPEName.Count));
                  end;
                end;
              end;
            end;
            ElmtCont.AddWideString(FXmlDtdDetailPETokenizer.TokenValue);
          until FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_END_OF_SOURCE_TOKEN;

          // VC: Proper Group/PE Nesting (XML 1.0, §§ 3.2.1 and 3.2.2)
          if BracketPEMisnested then
            FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_PARENTHESIZED_GROUP;

          // VC: Proper Declaration/PE Nesting (XML 1.0, § 2.8)
          if FXmlDtdDetailPETokenizer.CurrentPEName <> PEName then
            FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_DECL;

          if not (FErrorType in ET_FATAL_ERRORS) then
            FCurrentSignal := CreateElementDeclSignal(ElementName, ElmtCont.Value, IsProcessingPE);
        finally
          ElmtCont.Free;
        end;
      end;

      DTD_DETAIL_ENTITY_DECL_START_TOKEN: begin
        // Entity or parameter entity declaration
        // --------------------------------------
        //
        // Entity declaration start:
        FTokenType := DTD_ABSTRACT_ENTITY_DECL_TOKEN;
        FErrorType := ET_INVALID_ENTITY_DECL;
        PEName := FXmlDtdDetailPETokenizer.CurrentPEName;
        FEntityDeclBaseUri := FXmlDtdDetailPETokenizer.GetUri;
          // Remark: Cf. [XML 1.0], sec. 4.2.2:
          // "... relative URIs are relative to the location of the resource
          // within which the entity declaration occurs. This is defined to be
          // the external entity containing the '<' which starts the
          // declaration, at the point when it is parsed as a declaration."

        // Whitespace:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
          Exit;

        // Entity declaration name or %:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        case FXmlDtdDetailPETokenizer.TokenType of

          DTD_DETAIL_UNQUOTED_STRING_TOKEN: begin
            // Entity declaration:
            EntityName := FXmlDtdDetailPETokenizer.TokenValue;
          end;

          DTD_DETAIL_KEYWORD_TOKEN: begin
            // Parameter entity declaration:

            FTokenType := DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN;
            FErrorType := ET_INVALID_PARAMETER_ENTITY_DECL;
            if FXmlDtdDetailPETokenizer.TokenValue <> '%' then
              Exit;

            // Whitespace:
            FXmlDtdDetailPETokenizer.Next;
            if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
              FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
              FClue := FXmlDtdDetailPETokenizer.Clue;
              Exit;
            end;
            if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
              Exit;

            // Parameter entity name:
            FXmlDtdDetailPETokenizer.Next;
            if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
              FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
              FClue := FXmlDtdDetailPETokenizer.Clue;
              Exit;
            end;
            if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_UNQUOTED_STRING_TOKEN then
              Exit;
            EntityName := FXmlDtdDetailPETokenizer.TokenValue;
          end;

        else
          Exit;
        end; {case ...}

        // Whitespace:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
          Exit;

        // Entity definition:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        case FXmlDtdDetailPETokenizer.TokenType of

          DTD_DETAIL_QUOTED_STRING_TOKEN: begin
            // Internal entity
            // ---------------
            //
            // Entity value:
            S := Copy(FXmlDtdDetailPETokenizer.TokenValue,
                      2,
                      Length(FXmlDtdDetailPETokenizer.TokenValue) - 2); // Remove leading and trailing quotation mark.
            S1 := IncludePERefsInLiteral(S, ErrorKind);
            EntityValue := XmlReplaceQuotes(S1);
            if not (ErrorKind in ET_WARNINGS) then begin
              FErrorType := ErrorKind;
              Exit;
            end;

            // Optional whitespace:
            repeat
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
            until FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN;

            // '>':
            if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_DECL_END_TOKEN then
              Exit;

            FErrorType := ET_NONE;
            if FTokenType = DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN then begin
              try
                if not PERepository.Add(EntityName, S1) then
                  FErrorType := ET_DOUBLE_PARAMETER_ENTITY_DECL;
              except
                FErrorType := ET_INVALID_PARAMETER_ENTITY_DECL;
                Exit;
              end;
            end;

          end;

          DTD_DETAIL_UNQUOTED_STRING_TOKEN: begin
            // External entity
            // ---------------
            if FXmlDtdDetailPETokenizer.TokenValue = 'SYSTEM' then begin

              // Whitespace:
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then begin
                FClue := ' ';
                Exit;
              end;

              // System literal:
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_QUOTED_STRING_TOKEN then
                Exit;
              PubId := '';
              SysId := Copy(FXmlDtdDetailPETokenizer.TokenValue,
                            2,
                            Length(FXmlDtdDetailPETokenizer.TokenValue) - 2); // Remove leading and trailing quotation mark.
              if not IsXmlSystemChars(SysId) then
                Exit;

            end else if FXmlDtdDetailPETokenizer.TokenValue = 'PUBLIC' then begin

              // Whitespace:
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then begin
                FClue := ' ';
                Exit;
              end;

              // PubId literal:
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_QUOTED_STRING_TOKEN then
                Exit;
              PubId := Copy(FXmlDtdDetailPETokenizer.TokenValue,
                            2,
                            Length(FXmlDtdDetailPETokenizer.TokenValue) - 2); // Remove leading and trailing quotation mark.
              if not IsXmlPubidChars(PubId) then
                Exit;

              // Whitespace:
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then begin
                FClue := ' ';
                Exit;
              end;

              // System literal:
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_QUOTED_STRING_TOKEN then
                Exit;
              SysId := Copy(FXmlDtdDetailPETokenizer.TokenValue,
                            2,
                            Length(FXmlDtdDetailPETokenizer.TokenValue) - 2); // Remove leading and trailing quotation mark.
              if not IsXmlSystemChars(SysId) then
                Exit;

            end else
              Exit;

            if FTokenType = DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN then begin
              // Parameter entity declaration (end)

              // Optional whitespace:
              repeat
                FXmlDtdDetailPETokenizer.Next;
                if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                  FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                  FClue := FXmlDtdDetailPETokenizer.Clue;
                  Exit;
                end;
              until FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN;

              // '>':
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_DECL_END_TOKEN then
                Exit;
              FErrorType := ET_NONE;
              try
                PERepository.Add(EntityName, EntityDeclBaseUri, PubId, SysId);
              except
                FErrorType := ET_INVALID_PARAMETER_ENTITY_DECL;
                Exit;
              end;

            end else begin
              // Entity declaration (end)
              FXmlDtdDetailPETokenizer.Next;
              if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                FClue := FXmlDtdDetailPETokenizer.Clue;
                Exit;
              end;
              case FXmlDtdDetailPETokenizer.TokenType of

                DTD_DETAIL_DECL_END_TOKEN: begin
                  // '>':
                  FErrorType := ET_NONE;
                end;

                DTD_DETAIL_WHITESPACE_TOKEN: begin
                  FXmlDtdDetailPETokenizer.Next;
                  if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                    FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                    FClue := FXmlDtdDetailPETokenizer.Clue;
                    Exit;
                  end;
                  case FXmlDtdDetailPETokenizer.TokenType of
                    DTD_DETAIL_DECL_END_TOKEN: begin
                      // '>':
                      FErrorType := ET_NONE;
                    end;
                    DTD_DETAIL_UNQUOTED_STRING_TOKEN: begin
                      // 'NDATA' keyword:
                      if FXmlDtdDetailPETokenizer.TokenValue <> 'NDATA' then
                        Exit;
                      // Whitespace:
                      FXmlDtdDetailPETokenizer.Next;
                      if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                        FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                        FClue := FXmlDtdDetailPETokenizer.Clue;
                        Exit;
                      end;
                      if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then begin
                        FClue := ' ';
                        Exit;
                      end;
                      // Notation name:
                      FXmlDtdDetailPETokenizer.Next;
                      if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                        FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                        FClue := FXmlDtdDetailPETokenizer.Clue;
                        Exit;
                      end;
                      if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_UNQUOTED_STRING_TOKEN then
                        Exit;
                      NotationName := FXmlDtdDetailPETokenizer.TokenValue;
                      if not IsXmlName(NotationName) then
                        Exit;
                      // Optional whitespace:
                      repeat
                        FXmlDtdDetailPETokenizer.Next;
                        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                          FClue := FXmlDtdDetailPETokenizer.Clue;
                          Exit;
                        end;
                      until FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN;
                      // '>':
                      if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_DECL_END_TOKEN then
                        Exit;
                      FErrorType := ET_NONE;
                    end;
                  else
                    Exit;
                  end; {case ...}
                end;

              else
                Exit;
              end; {case ...}

            end; {if TokenType = DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN ... else ...}
          end; {DTD_DETAIL_UNQUOTED_STRING_TOKEN ...}

        else
          Exit;
        end; {case FXmlDtdDetailPETokenizer.TokenType ...}

        // VC: Proper Declaration/PE Nesting (XML 1.0, § 2.8)
        if FXmlDtdDetailPETokenizer.CurrentPEName <> PEName then
          FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_DECL;

        if FTokenType = DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN then begin
          if not (FErrorType in ET_FATAL_ERRORS) then
            FCurrentSignal := CreateParameterEntityDeclSignal(EntityName,
                                EntityValue, PubId, SysId, EntityDeclBaseUri);
        end else
        if FTokenType = DTD_ABSTRACT_ENTITY_DECL_TOKEN then begin
          if not (FErrorType in ET_FATAL_ERRORS) then
            FCurrentSignal := CreateEntityDeclSignal(EntityName,
                                EntityValue, PubId, SysId, NotationName, EntityDeclBaseUri, IsProcessingPE);
        end;
      end; {DTD_DETAIL_ENTITY_DECL_START_TOKEN ...}

      DTD_DETAIL_NOTATION_DECL_START_TOKEN: begin
        // Process notation declaration:
        // ---------------------------------
        //
        // Notation declaration start:
        FTokenType := DTD_ABSTRACT_NOTATION_DECL_TOKEN;
        FErrorType := ET_INVALID_NOTATION_DECL;
        PEName := FXmlDtdDetailPETokenizer.CurrentPEName;

        // Whitespace:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
          Exit;

        // Notation declaration name:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_UNQUOTED_STRING_TOKEN then
          Exit;
        NotationName := FXmlDtdDetailPETokenizer.TokenValue;

        // Whitespace:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then
          Exit;

        // 'SYSTEM' or 'PUBLIC' keyword:
        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_UNQUOTED_STRING_TOKEN then
          Exit;
        if FXmlDtdDetailPETokenizer.TokenValue = 'SYSTEM' then begin

          // Whitespace:
          FXmlDtdDetailPETokenizer.Next;
          if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            Exit;
          end;
          if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then begin
            FClue := ' ';
            Exit;
          end;

          // System literal:
          FXmlDtdDetailPETokenizer.Next;
          if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            Exit;
          end;
          if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_QUOTED_STRING_TOKEN then
            Exit;
          PubId := '';
          SysId := Copy(FXmlDtdDetailPETokenizer.TokenValue,
                        2,
                        Length(FXmlDtdDetailPETokenizer.TokenValue) - 2); // Remove leading and trailing quotation mark.
          if not IsXmlSystemChars(SysId) then
            Exit;

          // Optional whitespace:
          repeat
            FXmlDtdDetailPETokenizer.Next;
            if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
              FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
              FClue := FXmlDtdDetailPETokenizer.Clue;
              Exit;
            end;
          until FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN;

          // '>':
          if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_DECL_END_TOKEN then
            Exit;

          FErrorType := ET_NONE;

        end else if FXmlDtdDetailPETokenizer.TokenValue = 'PUBLIC' then begin

          // Whitespace:
          FXmlDtdDetailPETokenizer.Next;
          if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            Exit;
          end;
          if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN then begin
            FClue := ' ';
            Exit;
          end;

          // PubId literal:
          FXmlDtdDetailPETokenizer.Next;
          if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            Exit;
          end;
          if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_QUOTED_STRING_TOKEN then
            Exit;
          PubId := Copy(FXmlDtdDetailPETokenizer.TokenValue,
                        2,
                        Length(FXmlDtdDetailPETokenizer.TokenValue) - 2); // Remove leading and trailing quotation mark.
          if not IsXmlPubidChars(PubId) then
            Exit;

          // Whitespace (?):
          FXmlDtdDetailPETokenizer.Next;
          if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            Exit;
          end;
          if FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_WHITESPACE_TOKEN then begin

            FXmlDtdDetailPETokenizer.Next;
            if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
              FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
              FClue := FXmlDtdDetailPETokenizer.Clue;
              Exit;
            end;

            // '>':
            if FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_DECL_END_TOKEN then begin
              SysId := '';
              FErrorType := ET_NONE;
            end else
            // System literal:
            if FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_QUOTED_STRING_TOKEN then begin

              SysId := Copy(FXmlDtdDetailPETokenizer.TokenValue,
                            2,
                            Length(FXmlDtdDetailPETokenizer.TokenValue) - 2); // Remove leading and trailing quotation mark.
              if not IsXmlSystemChars(SysId) then
                Exit;

              // Optional whitespace:
              repeat
                FXmlDtdDetailPETokenizer.Next;
                if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
                  FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
                  FClue := FXmlDtdDetailPETokenizer.Clue;
                  Exit;
                end;
              until FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN;

              // '>':
              if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_DECL_END_TOKEN then
                Exit;

              FErrorType := ET_NONE;

            end else
              Exit;

          end else
          // '>':
          if FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_DECL_END_TOKEN then begin
            SysId := '';
            FErrorType := ET_NONE;
          end else
            Exit;

        end else
          Exit;

        // VC: Proper Declaration/PE Nesting (XML 1.0, § 2.8)
        if FXmlDtdDetailPETokenizer.CurrentPEName <> PEName then
          FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_DECL;

        if not (FErrorType in ET_FATAL_ERRORS) then
          FCurrentSignal := CreateNotationDeclSignal(NotationName, PubId, SysId, IsProcessingPE);
      end;

      DTD_DETAIL_PI_TARGET_TOKEN: begin
        // Process processing instructions:
        FTokenType := DTD_ABSTRACT_PI_TOKEN;
        PITarget := FXmlDtdDetailPETokenizer.TokenValue;

        FXmlDtdDetailPETokenizer.Next;
        if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
          FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
          FClue := FXmlDtdDetailPETokenizer.Clue;
          Exit;
        end;
        case FXmlDtdDetailPETokenizer.TokenType of

          // Whitespace:
          DTD_DETAIL_WHITESPACE_TOKEN: begin
            // PI content:
            FXmlDtdDetailPETokenizer.Next;
            if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
              FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
              FClue := FXmlDtdDetailPETokenizer.Clue;
              Exit;
            end;
            if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_PI_CONTENT_TOKEN then begin
              FErrorType := ET_UNCLOSED_PROCESSING_INSTRUCTION;
              FClue := '?>';
              Exit;
            end;
            PIData := FXmlDtdDetailPETokenizer.TokenValue;

          end;

          // PI without content:
          DTD_DETAIL_PI_CONTENT_TOKEN:
            if FXmlDtdDetailPETokenizer.TokenValue <> '' then begin
              FErrorType := ET_MISSING_WHITE_SPACE;
              FClue := ' ';
              Exit;
            end else
              PIData := '';

        else
          FErrorType := ET_UNCLOSED_PROCESSING_INSTRUCTION;
          FClue := '?>';
          Exit;
        end; {case ...}

        FCurrentSignal := CreatePISignal(PITarget, PIData);
      end;

      DTD_DETAIL_WHITESPACE_TOKEN: begin
        FTokenType := DTD_ABSTRACT_IGNORABLE_WHITESPACE_TOKEN;
      end;

      DTD_DETAIL_COND_SECT_START_TOKEN: begin

        if not (IsProcessingPE or FAllowConditionalSections) then begin
          FErrorType := ET_CONDITIONAL_SECTION_NOT_ALLOWED;
          Exit;
        end;

        FCondSectStartPEName.Append(FXmlDtdDetailPETokenizer.CurrentPEName);

        // Optional whitespace:
        repeat
          FXmlDtdDetailPETokenizer.Next;
          if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
            FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            Exit;
          end;
        until FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN;

        // 'INCLUDE' or 'IGNORE' keyword:
        S := FXmlDtdDetailPETokenizer.TokenValue;
        if (FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_UNQUOTED_STRING_TOKEN) or
           ( (S <> 'IGNORE') and (S <> 'INCLUDE') ) then
        begin
          FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
          FTokenType := DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN;
          FErrorType := ET_INVALID_CONDITIONAL_SECTION;
          Exit;
        end;

        // Optional whitespace:
        repeat
          FXmlDtdDetailPETokenizer.Next;
          if FXmlDtdDetailPETokenizer.ErrorType in ET_FATAL_ERRORS then begin
            FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            Exit;
          end;
        until FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_WHITESPACE_TOKEN;

        // '[':
        if FXmlDtdDetailPETokenizer.TokenType <> DTD_DETAIL_COND_SECT_OPENER_TOKEN then begin
          FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
          FTokenType := DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN;
          FErrorType := ET_INVALID_CONDITIONAL_SECTION;
          FClue := '[';
          Exit;
        end;

        FCondSectBracketPEName.Append(FXmlDtdDetailPETokenizer.CurrentPEName);

        if S = 'INCLUDE' then begin
          Next;
        end else begin
          FXmlDtdDetailPETokenizer.NextEndOfIgnoredCondSect;
          if FXmlDtdDetailPETokenizer.ErrorType <> ET_NONE then begin
            FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
            FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
            FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
            FClue := FXmlDtdDetailPETokenizer.Clue;
            FTokenType := DTD_ABSTRACT_INVALID_MARKUP_TOKEN;
          end else if FXmlDtdDetailPETokenizer.TokenType = DTD_DETAIL_COND_SECT_END_TOKEN then begin
            if FCondSectStartPEName[Pred(FCondSectStartPEName.Count)] <> FCondSectBracketPEName[Pred(FCondSectBracketPEName.Count)] then begin
              FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
              FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
              FTokenType := DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN;
              FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_CONDITIONAL_SECTION;
              FClue := '[';
              Exit;
            end;
            if FCondSectStartPEName[Pred(FCondSectStartPEName.Count)] <> FXmlDtdDetailPETokenizer.CurrentPEName then begin
              FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
              FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
              FTokenType := DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN;  
              FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_CONDITIONAL_SECTION;
              FClue := ']]>';
              Exit;
            end;
            FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
            FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
            Next;
          end else begin
            FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
            FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
            FErrorType := ET_INVALID_CONDITIONAL_SECTION;
          end;
        end;
      end;

      DTD_DETAIL_COND_SECT_END_TOKEN: begin
        if FCondSectStartPEName.Count = 0 then begin
          // End of conditional section without start
          FTokenType := DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN;
          FErrorType := ET_INVALID_CONDITIONAL_SECTION;
        end else begin
          if FCondSectStartPEName[Pred(FCondSectStartPEName.Count)] <> FCondSectBracketPEName[Pred(FCondSectBracketPEName.Count)] then begin
            FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
            FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
            FTokenType := DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN;
            FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_CONDITIONAL_SECTION;
            FClue := '[';
            Exit;
          end;
          if FCondSectStartPEName[Pred(FCondSectStartPEName.Count)] <> FXmlDtdDetailPETokenizer.CurrentPEName then begin
            FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
            FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
            FTokenType := DTD_ABSTRACT_CONDITIONAL_SECTION_TOKEN;
            FErrorType := ET_PE_NOT_PROPERLY_NESTED_WITH_CONDITIONAL_SECTION;
            FClue := ']]>';
            Exit;
          end;
          FCondSectStartPEName.Delete(Pred(FCondSectStartPEName.Count));
          FCondSectBracketPEName.Delete(Pred(FCondSectBracketPEName.Count));
          Next;
        end;
      end;

      DTD_DETAIL_END_OF_SOURCE_TOKEN: begin
        FTokenType := DTD_ABSTRACT_END_OF_SOURCE_TOKEN;
        if FCondSectStartPEName.Count <> 0 then begin
          FErrorType := ET_UNCLOSED_CONDITIONAL_SECTION;
          FClue := ']]>';
        end;
      end;

      DTD_DETAIL_PARAMETER_ENTITY_REF_TOKEN: begin
        // Process reference to an external parameter entity (which has not been resolved):
        FTokenType := DTD_ABSTRACT_EXT_PARAMETER_ENTITY_REF_TOKEN;
        FCurrentSignal := CreateExtPERefSignal(FXmlDtdDetailPETokenizer.TokenValue);
        FErrorType := FXmlDtdDetailPETokenizer.ErrorType;
        FClue := FXmlDtdDetailPETokenizer.Clue;
      end;

      DTD_DETAIL_COND_SECT_OPENER_TOKEN,
      DTD_DETAIL_DECL_END_TOKEN,
      DTD_DETAIL_KEYWORD_TOKEN,
      DTD_DETAIL_OPERATOR_TOKEN,
      DTD_DETAIL_PI_CONTENT_TOKEN,
      DTD_DETAIL_QUOTED_STRING_TOKEN,
      DTD_DETAIL_UNQUOTED_STRING_TOKEN: begin
        FTokenType := DTD_ABSTRACT_INVALID_MARKUP_TOKEN;
        FErrorType := ET_INVALID_MARKUP_DECL;
      end;

    end; {case ...}
  end;
end;

function TXmlCustomSubsetTokenizer.FindNextAttDef(    Decl: WideString;
                                                  out AttType: TXmlDataType;
                                                  out Constraint: TDomAttrValueConstraint;
                                                  out AttName,
                                                      Enumeration,
                                                      DefaultValue,
                                                      Rest: WideString): Boolean;
// Return value: 'False' if a wellformedness error occured; 'True' otherwise.

  function StrToDataType(const S: WideString;
                           out DataType: TXmlDataType): Boolean;
  begin
    if S = '' then begin
      DataType := AS_NMTOKEN_DATATYPE;
      Result := True;
    end else if S = 'CDATA' then begin
      DataType := AS_STRING_DATATYPE;
      Result := True;
    end else if S = 'ID' then begin
      DataType := AS_ID_DATATYPE;
      Result := True;
    end else if S = 'IDREF' then begin
      DataType := AS_IDREF_DATATYPE;
      Result := True;
    end else if S = 'IDREFS' then begin
      DataType := AS_IDREFS_DATATYPE;
      Result := True;
    end else if S = 'ENTITY' then begin
      DataType := AS_ENTITY_DATATYPE;
      Result := True;
    end else if S = 'ENTITIES' then begin
      DataType := AS_ENTITIES_DATATYPE;
      Result := True;
    end else if S = 'NMTOKEN' then begin
      DataType := AS_NMTOKEN_DATATYPE;
      Result := True;
    end else if S = 'NMTOKENS' then begin
      DataType := AS_NMTOKENS_DATATYPE;
      Result := True;
    end else if S = 'NOTATION' then begin
      DataType := AS_NOTATION_DATATYPE;
      Result := True;
    end else
      Result := False;
  end;

  function StrToConstaintType(const S: WideString;
                                var AVC: TDomAttrValueConstraint): Boolean;
  begin
    if S = '#REQUIRED' then begin
      AVC := AVC_REQUIRED;
      Result := True;
    end else if S = '#IMPLIED' then begin
      AVC := AVC_IMPLIED;
      Result := True;
    end else if S = '#FIXED' then begin
      AVC := AVC_FIXED;
      Result := True;
    end else
      Result := False;
  end;

var
  I, J: Integer;
  FindEnumeration, FindConstraint, FindDefaultValue: Boolean;
  QuoteType: WideChar;
  S: WideString;
begin
  Result := True;

  S := '';
  DefaultValue := '';
  Enumeration := '';
  FindDefaultValue := False;
  FindEnumeration := False;
  FindConstraint := False;
  Constraint := AVC_DEFAULT;
  AttName := '';
  Rest := '';

  if Length(Decl) = 0
    then begin Result := False; Exit; end;
  I := 1;

  {White-space?}
  while IsXmlWhiteSpace(Decl[I]) do begin
    Inc(I);
    if I > Length(Decl)
      then begin Result := False; Exit; end;
  end;
  J := I;

  {AttName?}
  while not IsXmlWhiteSpace(Decl[I]) do begin
    Inc(I);
    if I > Length(Decl)
      then begin Result := False; Exit; end;
  end;
  AttName := Copy(Decl, J, I - J);

  {White-space?}
  while IsXmlWhiteSpace(Decl[I]) do begin
    Inc(I);
    if I > Length(Decl)
      then begin Result := False; Exit; end;
  end;
  J := I;

  if Decl[J] = '(' then FindEnumeration:= True;

  {AttType?}
  if FindEnumeration then begin
    AttType := AS_NMTOKEN_DATATYPE;
  end else begin
    while not IsXmlWhiteSpace(Decl[I]) do begin
      Inc(I);
      if I > Length(Decl)
        then begin Result := False; Exit; end;
    end;
    if not StrToDataType(Copy(Decl, J, I - J), AttType)
      then begin Result := False; Exit; end;
    if AttType = AS_NOTATION_DATATYPE then
      FindEnumeration := True;

    {White-space?}
    while IsXmlWhiteSpace(Decl[I]) do begin
      Inc(I);
      if I > Length(Decl)
        then begin Result := False; Exit; end;
    end;
    J := I;
  end; {if ...}

  {Bracket?}
  if FindEnumeration then begin
    if Decl[J] <> '('
      then begin Result := False; Exit; end;
    while not (Decl[I] = ')') do begin
      Inc(I);
      if I >= Length(Decl)
        then begin Result := False; Exit; end;
    end;
    Enumeration := Copy(Decl, J, I - J + 1);

    {White-space?}
    Inc(I);
    if not IsXmlWhiteSpace(Decl[I])
      then begin Result := False; Exit; end;
    while IsXmlWhiteSpace(Decl[I]) do begin
      Inc(I);
      if I > Length(Decl)
        then begin Result := False; Exit; end;
    end;
    J := I;
  end; {if ...}

  if Decl[J] = '#'
    then FindConstraint := True
    else FindDefaultValue := True;

  {Constraint?}
  if FindConstraint then begin
    while not IsXmlWhiteSpace(Decl[I]) do begin
      Inc(I);
      if I > Length(Decl) then Break;
    end; {while ...}
    if not  StrToConstaintType(Copy(Decl, J, I - J), Constraint)
      then begin Result := False; Exit; end;
    if Constraint = AVC_FIXED then begin
      FindDefaultValue := True;
      {White-space?}
      if I > Length(Decl)
        then begin Result := False; Exit; end;
      while IsXmlWhiteSpace(Decl[I]) do begin
        Inc(I);
        if I > Length(Decl)
          then begin Result := False; Exit; end;
      end; {while ...}
      J := I;
    end; {if ...}
  end; {if ...}

  {DefaultValue?}
  if FindDefaultValue then begin
    if I = Length(Decl)
      then begin Result := False; Exit; end;
    QuoteType := Decl[I];
    if not ( (QuoteType = '"') or (QuoteType = #$0027))
      then begin Result := False; Exit; end;
    Inc(I);
    while not (Decl[I] = QuoteType) do begin
      Inc(I);
      if I > Length(Decl)
        then begin Result := False; Exit; end;
    end; {while ...}
    DefaultValue := Copy(Decl, J + 1, I - J - 1);
    Inc(I);
  end; {if ...}

  Rest:= Copy(Decl, I, Length(Decl) - I + 1);
end;

function TXmlCustomSubsetTokenizer.GetEndByteNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetEndByteNumber;
end;

function TXmlCustomSubsetTokenizer.GetEndCharNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetEndCharNumber;
end;

function TXmlCustomSubsetTokenizer.GetEndColumnNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetEndColumnNumber;
end;

function TXmlCustomSubsetTokenizer.GetEndLineNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetEndLineNumber;
end;

function TXmlCustomSubsetTokenizer.GetEndTabsInLine: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetEndTabsInLine;
end;

function TXmlCustomSubsetTokenizer.GetRelatedDtdObject: TDtdObject;
begin
  Result := FXmlDtdDetailPETokenizer.GetRelatedDtdObject;
end;

function TXmlCustomSubsetTokenizer.GetRelatedNode: TDomNode;
begin
  Result := FXmlDtdDetailPETokenizer.GetRelatedNode;
end;

function TXmlCustomSubsetTokenizer.GetStartByteNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetStartByteNumber;
end;

function TXmlCustomSubsetTokenizer.GetStartCharNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetStartCharNumber;
end;

function TXmlCustomSubsetTokenizer.GetStartColumnNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetStartColumnNumber;
end;

function TXmlCustomSubsetTokenizer.GetStartLineNumber: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetStartLineNumber;
end;

function TXmlCustomSubsetTokenizer.GetStartTabsInLine: Int64;
begin
  Result := FXmlDtdDetailPETokenizer.GetStartTabsInLine;
end;

function TXmlCustomSubsetTokenizer.GetUri: WideString;
begin
  Result := FXmlDtdDetailPETokenizer.GetUri;
end;

function TXmlCustomSubsetTokenizer.IncludePERefsInLiteral(const S: WideString;
                                                           out ErrType: TXmlErrorType): WideString;
const
  NULL:      WideChar = #$00; // End of WideString mark
  PERCENT:   WideChar = #$25; // '%'
  COLON:     WideChar = #$3A; // ':'
  SEMICOLON: WideChar = #$3B; // ';'
  LOW_LINE:  WideChar = #$5F; // '_'
  PERCENT_CODE = $25; // code of %
var
  P : PWideChar;
  ResultStr: TUtilsCustomWideStr;
  PEStr: TUtilsCustomWideStr;
  PEValue, PEPubId, PESysId: WideString;
begin
  ErrType := ET_NONE;
  ResultStr := TUtilsCustomWideStr.Create;
  try
    P := PWideChar(S);
    while P^ <> NULL do begin
      if P^ = PERCENT then begin
        Inc(P);
        if IsXmlLetter(P^) or (P^ = COLON) or (P^ = LOW_LINE) then begin
          PEStr := TUtilsCustomWideStr.Create;
          try
            PEStr.AddWideChar(P^);
            Inc(P);
            while IsXmlNameChar(P^) do begin
              PEStr.AddWideChar(P^);
              Inc(P);
            end;
            if P^ = SEMICOLON then begin
              // PE found:
              if AllowPEsInMarkup or IsProcessingPE then begin
                // Include as PE:
                ErrType := PERepository.ResolvePE(PEStr.Value, True, PEValue, PEPubId, PESysId);
                ResultStr.AddWideString(PEValue);
              end else
                ErrType := ET_PARAMETER_ENTITY_REF_NOT_ALLOWED;
              if ErrType <> ET_NONE then begin
                Result := S;
                Exit;
              end;
            end else begin
              ResultStr.AddUCS4Char(PERCENT_CODE);
              ResultStr.AddWideString(PEStr.Value);
              Dec(P);
            end;
          finally
            PEStr.Free;
          end;
        end else begin
          ResultStr.AddUCS4Char(PERCENT_CODE);
          Dec(P);
        end;
      end else ResultStr.AddWideChar(P^);
      Inc(P);
    end;
    Result := ResultStr.Value;
  finally
    ResultStr.Free;
  end;
end;

function TXmlCustomSubsetTokenizer.ProcessPendingAttrDef: Boolean;
// If an attribute list declaration had been encountered its attribute
// definitions typically cannot be processed in one turn.  Thus, the pending
// attribute definitions are stored in the backup FPendingAttrDefs WideString
// variable and gradually processed whenever Next is called.
//
// This function returns True, if a pending attribute definition had been
// processed (successfully or not). Otherwise False is returned.
var
  Dummy, Piece: WideString;
  Separator: Integer;
  Error, Ok: Boolean;
  AttType: TXmlDataType;
  Constraint: TDomAttrValueConstraint;
  AttDefName, Enum1, Enum2, DefaultValue, Rest: WideString;
begin
  Dummy := TrimWhitespace(FPendingAttrDefs);
  FPendingAttrDefs := Dummy;

  if FPendingAttrDefs <> '' then begin
    Result := True;
    Ok := FindNextAttDef(FPendingAttrDefs, AttType, Constraint, AttDefName, Enum1, DefaultValue, Rest);
    FPendingAttrDefs := Rest;

    if not Ok then begin
      FErrorType := ET_INVALID_ATTRIBUTE_DECL;
      Exit;
    end;

    FCurrentSignal := TXmlAttributeDefinitionSignal.CreateFromLocator(nil, Self);
    try
      (FCurrentSignal as TXmlAttributeDefinitionSignal).AttributeName := AttDefName;
      (FCurrentSignal as TXmlAttributeDefinitionSignal).AttributeType := AttType;
      (FCurrentSignal as TXmlAttributeDefinitionSignal).Constraint := Constraint;
      (FCurrentSignal as TXmlAttributeDefinitionSignal).DefaultValue := DefaultValue;
      (FCurrentSignal as TXmlAttributeDefinitionSignal).ElementName := FAttDeclElementType;
      (FCurrentSignal as TXmlAttributeDefinitionSignal).IsDeclaredInPE := IsProcessingPE;

      // Process enumeration of attributes:
      if Enum1 <> '' then begin
        XMLTruncRoundBrackets(Enum1, Enum2, Error);
        if Error or (Enum2 = '') then begin
          FErrorType := ET_INVALID_ATTRIBUTE_DECL;
          Exit;
        end;
        while Enum2 <> '' do begin
          Separator := Pos(WideString('|'), Enum2);
          if Separator = 0 then begin
            Piece := Enum2;
            Enum2 := '';
          end else begin
            Piece := TrimWhitespace(Copy(Enum2, 1, Separator - 1));
            Dummy := TrimWhitespace(Copy(Enum2, Separator + 1, Length(Enum2) - Separator));
            Enum2 := Dummy;
            if Enum2 = '' then begin
              FErrorType := ET_INVALID_ATTRIBUTE_DECL;
              Exit;
            end;
          end;
          (FCurrentSignal as TXmlAttributeDefinitionSignal).Enumeration.Add(Piece);
        end; {while ...}
      end;

    except
      FCurrentSignal.Free;
      FCurrentSignal := nil;
      raise;
    end;

  end else
    Result := False;
end;



{ TXmlExtSubsetTokenizer }

constructor TXmlExtSubsetTokenizer.Create(const AInputSource: TXmlInputSource;
                                          const APERepository: TDomPERepository);
begin
  inherited Create(AInputSource, APERepository);

  FXmlDtdDetailPETokenizer.PERefTreatment := petResolve;

  if AInputSource.HasMalformedDecl
     or not ( AInputSource.DeclType in [ DT_TEXT_DECLARATION,
                                         DT_XML_OR_TEXT_DECLARATION,
                                         DT_UNSPECIFIED ] )
  then begin
    FTokenType := DTD_ABSTRACT_END_OF_SOURCE_TOKEN;
    FErrorType := ET_INVALID_TEXT_DECL;
  end else if AInputSource.XmlVersion <> '1.0' then begin
    FTokenType := DTD_ABSTRACT_END_OF_SOURCE_TOKEN;
    FErrorType := ET_XML_VERSION_NOT_SUPPORTED;
  end else begin
    FTokenType := DTD_ABSTRACT_START_OF_SOURCE_TOKEN;
    FErrorType := ET_NONE;
  end;
end;

procedure TXmlExtSubsetTokenizer.ResolveParameterEntityEventHandler(      Sender: TObject;
                                                                    const EntityName: WideString;
                                                                      var EntityValue,
                                                                          PubId,
                                                                          SysId: WideString;
                                                                      var Error: TXmlErrorType);
begin
  DoPEReference;
  Error := PERepository.ResolvePE(EntityName, True, EntityValue, PubId, SysId);
end;



{ TXmlIntSubsetTokenizer }

constructor TXmlIntSubsetTokenizer.Create(const AInputSource: TXmlSimpleInputSource;
                                          const APERepository: TDomPERepository);
begin
  inherited Create(AInputSource, APERepository);
  FAllowConditionalSections := False;
  FXmlDtdDetailPETokenizer.PERefTreatment := petResolveInDeclSep;
end;

function TXmlIntSubsetTokenizer.GetResolveExtPEs: Boolean;
begin
  Result := FXmlDtdDetailPETokenizer.PERefTreatment <> petResolveInDeclSepSkipExt;
end;

procedure TXmlIntSubsetTokenizer.ResolveParameterEntityEventHandler(      Sender: TObject;
                                                                    const EntityName: WideString;
                                                                      var EntityValue,
                                                                          PubId,
                                                                          SysId: WideString;
                                                                      var Error: TXmlErrorType);
begin
  DoPEReference;
  Error := PERepository.ResolvePE(EntityName, ResolveExtPEs, EntityValue, PubId, SysId);
end;


procedure TXmlIntSubsetTokenizer.SetResolveExtPEs(const Value: Boolean);
begin
  if Value
    then FXmlDtdDetailPETokenizer.PERefTreatment := petResolveInDeclSep
    else FXmlDtdDetailPETokenizer.PERefTreatment := petResolveInDeclSepSkipExt;
end;



{ TXmlElementCMTokenizer }

constructor TXmlElementCMTokenizer.Create(const S: WideString);
begin
  inherited Create;
  FBracketFound := False;
  FUCS4Reader := nil;   // Remark: If an exception occurs, the destructor is automatically called.
  FStringStream := nil; //         Therefore, we need to initialize critical objects with nil first.
  FTokenValue := TUtilsCustomWideStr.Create;
  FStringStream := TUtilsWideStringStream.Create(S);
  FUCS4Reader := TUtilsUCS4Reader.Create(FStringStream, 4096, TUTF16LECodec, 0, 0, 0, 0, 1);  
  FTokenType := DTD_ECM_START_OF_SOURCE_TOKEN;
  FErrorType := ET_NONE;
end;

destructor TXmlElementCMTokenizer.Destroy;
begin
  FUCS4Reader.Free;  // Remark: Free the UCS-4 Reader before the stream.
  FStringStream.Free;
  FTokenValue.Free;
  inherited;
end;

function TXmlElementCMTokenizer.GetTokenValue: WideString;
begin
  Result := FTokenValue.Value;
end;

procedure TXmlElementCMTokenizer.Next;
const
  NUMBER_CODE            = $23; // code of #
  OPENING_BRACKET_CODE   = $28; // code of (
  CLOSING_BRACKET_CODE   = $29; // code of )
  ASTERISK_CODE          = $2A; // code of *
  PLUS_SIGN_CODE         = $2B; // code of +
  COMMA_CODE             = $2C; // code of ,
  COLON_CODE             = $3A; // code of :
  QM_CODE                = $3F; // code of ?
  LOW_LINE_CODE          = $5F; // code of _
  VERTICAL_LINE_CODE     = $7C; // code of |
  STRING_TERMINATOR_CODE = $9C;

  PCDATA_KEYWORD: array[0..5] of UCS4Char =
    (Ord('P'), Ord('C'), Ord('D'), Ord('A'), Ord('T'), Ord('A'));

  ANY_KEYWORD: WideString = 'ANY';
  EMPTY_KEYWORD: WideString = 'EMPTY';
var
  I: Integer;
begin
  if FTokenType = DTD_ECM_END_OF_SOURCE_TOKEN then Exit;

  FTokenValue.Clear;
  FErrorType := ET_NONE;
  FClue := '';

  try
    repeat
      FUCS4Reader.Next;
    until not IsXmlWhiteSpaceCodePoint(FUCS4Reader.CurrentCharInfo.CodePoint); // Skip whitespace.

    case FUCS4Reader.CurrentCharInfo.CodePoint of

      NUMBER_CODE: begin
        FTokenType := DTD_ECM_PCDATA_KEYWORD_TOKEN;
        FTokenValue.AddUCS4Char(NUMBER_CODE);
        for I := 0 to 5 do
          if FUCS4Reader.NextCharInfo.CodePoint = PCDATA_KEYWORD[I] then begin
            FUCS4Reader.Next;
            FTokenValue.AddUCS4Char(FUCS4Reader.CurrentCharInfo.CodePoint);
          end else begin
            FErrorType := ET_INVALID_CONTENT_MODEL_TOKEN_IN_ELEMENT_DECL;
            FClue := '#PCDATA';
          end;
      end;

      OPENING_BRACKET_CODE: begin
        FBracketFound := True;
        FTokenType := DTD_ECM_OPENING_BRACKET_TOKEN;
        FTokenValue.AddUCS4Char(OPENING_BRACKET_CODE);
      end;

      CLOSING_BRACKET_CODE: begin
        FTokenType := DTD_ECM_CLOSING_BRACKET_TOKEN;
        FTokenValue.AddUCS4Char(CLOSING_BRACKET_CODE);
      end;

      ASTERISK_CODE: begin
        FTokenType := DTD_ECM_FREQUENCY_TOKEN;
        FTokenValue.AddUCS4Char(ASTERISK_CODE);
      end;

      PLUS_SIGN_CODE: begin
        FTokenType := DTD_ECM_FREQUENCY_TOKEN;
        FTokenValue.AddUCS4Char(PLUS_SIGN_CODE);
      end;

      COMMA_CODE: begin
        FTokenType := DTD_ECM_SEPARATOR_TOKEN;
        FTokenValue.AddUCS4Char(COMMA_CODE);
      end;

      QM_CODE: begin
        FTokenType := DTD_ECM_FREQUENCY_TOKEN;
        FTokenValue.AddUCS4Char(QM_CODE);
      end;

      VERTICAL_LINE_CODE: begin
        FTokenType := DTD_ECM_SEPARATOR_TOKEN;
        FTokenValue.AddUCS4Char(VERTICAL_LINE_CODE);
      end;

      // End of source found:
      STRING_TERMINATOR_CODE: begin
        FTokenType := DTD_ECM_END_OF_SOURCE_TOKEN;
      end;

    else
      // ANY or EMPTY keword, or Element type name found etc.:
      FTokenType := DTD_ECM_NAME_TOKEN;
      FTokenValue.AddUCS4Char(FUCS4Reader.CurrentCharInfo.CodePoint);
      if IsXmlLetterCodePoint(FUCS4Reader.CurrentCharInfo.CodePoint) or
         (FUCS4Reader.CurrentCharInfo.CodePoint = COLON_CODE) or
         (FUCS4Reader.CurrentCharInfo.CodePoint = LOW_LINE_CODE)
      then begin
        while IsXmlNameCharCodePoint(FUCS4Reader.NextCharInfo.CodePoint) do begin
          FUCS4Reader.Next;
          FTokenValue.AddUCS4Char(FUCS4Reader.CurrentCharInfo.CodePoint);
        end;
        if not FBracketFound then begin
          if FTokenValue.IsEqual(ANY_KEYWORD) then
            FTokenType := DTD_ECM_ANY_KEYWORD_TOKEN
          else if FTokenValue.IsEqual(EMPTY_KEYWORD) then
            FTokenType := DTD_ECM_EMPTY_KEYWORD_TOKEN;
        end;
      end else begin
        FTokenType := DTD_ECM_INVALID_MARKUP_TOKEN;
        FErrorType := ET_INVALID_CONTENT_MODEL_TOKEN_IN_ELEMENT_DECL; 
      end;
    end;

  except
    on EConvertError do 
      FErrorType := ET_INVALID_CHARACTER;
  end; {try ...}
end;



{ TXmlAttrValueTokenizer }

constructor TXmlAttrValueTokenizer.Create(const S: WideString; ReadLFOption: TCodecReadLFOption = lrNormalize);
begin
  inherited Create;
  FUCS4Reader := nil;   // Remark: If an exception occurs, the destructor is automatically called.
  FStringStream := nil; //         Therefore, we need to initialize critical objects with nil first.
  FTokenValue := TUtilsCustomWideStr.Create;
  FStringStream := TUtilsWideStringStream.Create(S);
  FUCS4Reader := TUtilsUCS4Reader.Create(FStringStream, 4096, TUTF16LECodec, 0, 0, 0, 0, 1, ReadLFOption);
  FTokenType := ATTR_START_OF_SOURCE_TOKEN;
  FErrorType := ET_NONE;
end;

destructor TXmlAttrValueTokenizer.Destroy;
begin
  FUCS4Reader.Free;  // Remark: Free the UCS-4 Reader before the stream.
  FStringStream.Free;
  FTokenValue.Free;
  inherited;
end;

function TXmlAttrValueTokenizer.GetTokenValue: WideString;
begin
  Result := FTokenValue.Value;
end;

procedure TXmlAttrValueTokenizer.Next;
const
  NUMBER_CODE      = $23; // code of #
  AMP_CODE         = $26; // code of &
  SEMICOLON_CODE   = $3B; // code of ;
  LT_CODE          = $3C; // code of <
  STRING_TERMINATOR_CODE = $9C;
begin
  if FTokenType = ATTR_END_OF_SOURCE_TOKEN then Exit;

  FTokenValue.Clear;
  FErrorType := ET_NONE;

  FUCS4Reader.Next;

  case FUCS4Reader.CurrentCharInfo.CodePoint of

    // '&' Entity found:
    AMP_CODE: begin

      // Entity reference or character reference?
      if FUCS4Reader.NextCharInfo.CodePoint = NUMBER_CODE then begin
        FUCS4Reader.Next;
        FTokenType := ATTR_CHAR_REF;
        FErrorType := ET_UNCLOSED_CHAR_REF;
      end else begin
        FTokenType := ATTR_ENTITY_REF;
        FErrorType := ET_UNCLOSED_ENTITY_REF;
      end;

      FErrorType := ET_NONE;
      while FUCS4Reader.NextCharInfo.CodePoint <> STRING_TERMINATOR_CODE do begin
        FUCS4Reader.Next;

        // End of entity reference (';') found?
        if FUCS4Reader.CurrentCharInfo.CodePoint = SEMICOLON_CODE then begin
          FErrorType := ET_NONE;
          Exit;
        end;

        FTokenValue.AddUCS4Char(FUCS4Reader.CurrentCharInfo.CodePoint);
      end;

    end;

    // End of source found:
    STRING_TERMINATOR_CODE: begin
      FTokenType := ATTR_END_OF_SOURCE_TOKEN;
    end;

  else
    // Ordinary text found:
    FTokenType := ATTR_TEXT;
    FTokenValue.AddUCS4Char(FUCS4Reader.CurrentCharInfo.CodePoint);
  end;
end;



// +++++++++++++++++++++++++ TXmlOutputSource +++++++++++++++++++++++++
constructor TXmlOutputSource.Create(const Stream: TStream;
                                    const BufSize: Integer);
begin
  inherited;
  FCodec := nil;
  SetCodecClass(TUTF8Codec); // Sets also the default LFTranscoding.
end;

destructor TXmlOutputSource.Destroy;
begin
  FCodec.Free;
  inherited;
end;

function TXmlOutputSource.GetCodecClass: TUnicodeCodecClass;
begin
  if Assigned(FCodec)
    then Result := TUnicodeCodecClass(FCodec.ClassType)
    else Result := nil;
end;

function TXmlOutputSource.GetWriteLFOption: TCodecWriteLFOption;
begin
  Result := FCodec.WriteLFOption;
end;

procedure TXmlOutputSource.SetCodecClass(const Value: TUnicodeCodecClass);
var
  OldWriteLFOption: TCodecWriteLFOption;
begin
  if Assigned(FCodec) then begin
    OldWriteLFOption := FCodec.WriteLFOption;
    FCodec.Free;
  end else OldWriteLFOption := lwCRLF;  // default LFTranscoding.
  if Assigned(Value) then begin
    FCodec := Value.Create;
    FCodec.OnWrite := WriteEventHandler;
    FCodec.WriteLFOption := OldWriteLFOption;
  end else FCodec := nil;
end;

procedure TXmlOutputSource.SetWriteLFOption(const Value: TCodecWriteLFOption);
begin
  FCodec.WriteLFOption:= Value;
end;

procedure TXmlOutputSource.WriteEventHandler(Sender: TObject; const Buf;
  Count: Integer);
begin
  Write(Buf, Count);
end;

procedure TXmlOutputSource.WriteUCS4Char(const C: UCS4Char;
                                           out ByteCount: Integer);
begin
  FCodec.WriteUCS4Char(C, ByteCount);
end;



// ++++++++++++++++++++++++++ TDomError ++++++++++++++++++++++++++
constructor TDomError.Create(const ARelatedException: TXmlErrorType;
                             const AStartByteNumber,
                                   AStartCharNumber,
                                   AStartColumnNumber,
                                   AStartLineNumber,
                                   AStartTabsInLine,
                                   AEndByteNumber,
                                   AEndCharNumber,
                                   AEndColumnNumber,
                                   AEndLineNumber,
                                   AEndTabsInLine: Int64;
                             const AUri: WideString;
                             const ARelatedDtdObject: TDtdObject;
                             const ARelatedNode: TDomNode;
                             const ACode,
                                   AClue: WideString);
begin
  inherited Create;

  FRelatedException :=  ARelatedException;

  FStartByteNumber :=   AStartByteNumber;
  FStartCharNumber :=   AStartCharNumber;
  FStartColumnNumber := AStartColumnNumber;
  FStartLineNumber :=   AStartLineNumber;
  FStartTabsInLine :=   AStartTabsInLine;
  FEndByteNumber :=     AEndByteNumber;
  FEndCharNumber :=     AEndCharNumber;
  FEndColumnNumber :=   AEndColumnNumber;
  FEndLineNumber :=     AEndLineNumber;
  FEndTabsInLine :=     AEndTabsInLine;
  FUri :=               AUri;
  FRelatedDtdObject :=  ARelatedDtdObject;
  FRelatedNode :=       ARelatedNode;
  FCode :=              ACode;
  FClue :=              AClue;
end;

constructor TDomError.CreateFromLocator(const ARelatedException: TXmlErrorType;
                                        const ALocation: IDomLocator;
                                        const ACode,
                                              AClue: WideString);
begin
  if Assigned(ALocation) then
    with ALocation do
      Self.Create(ARelatedException,  StartByteNumber, StartCharNumber,
          StartColumnNumber, StartLineNumber, StartTabsInLine, EndByteNumber,
          EndCharNumber, EndColumnNumber, EndLineNumber, EndTabsInLine, Uri,
          RelatedDtdObject, RelatedNode, ACode, AClue)
   else Create(ARelatedException, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil, ACode, AClue);
end;

function TDomError.CloneError: TDomError;
begin
  Result := TDomErrorClass(ClassType).Create(RelatedException, StartByteNumber,
          StartCharNumber, StartColumnNumber, StartLineNumber, StartTabsInLine,
          EndByteNumber, EndCharNumber, EndColumnNumber, EndLineNumber,
          EndTabsInLine, Uri, RelatedDtdObject, RelatedNode, Code, Clue);
end;

function TDomError.GetEndByteNumber: Int64;
begin
  Result := FEndByteNumber;
end;

function TDomError.GetEndCharNumber: Int64;
begin
  Result := FEndCharNumber;
end;

function TDomError.GetEndColumnNumber: Int64;
begin
  Result := FEndColumnNumber;
end;

function TDomError.GetEndLineNumber: Int64;
begin
  Result := FEndLineNumber;
end;

function TDomError.GetEndTabsInLine: Int64;
begin
  Result := FEndTabsInLine;
end;

function TDomError.GetRelatedDtdObject: TDtdObject;
begin
  Result := FRelatedDtdObject;
end;

function TDomError.GetRelatedNode: TDomNode;
begin
  Result := FRelatedNode;
end;

function TDomError.GetSeverity: TDomSeverity;
begin
  if RelatedException in ET_FATAL_ERRORS
    then Result := DOM_SEVERITY_FATAL_ERROR
  else if RelatedException in ET_ERRORS
    then Result := DOM_SEVERITY_ERROR
  else Result := DOM_SEVERITY_WARNING;
end;

function TDomError.GetStartByteNumber: Int64;
begin
  Result := FStartByteNumber;
end;

function TDomError.GetStartCharNumber: Int64;
begin
  Result := FStartCharNumber;
end;

function TDomError.GetStartColumnNumber: Int64;
begin
  Result := FStartColumnNumber;
end;

function TDomError.GetStartLineNumber: Int64;
begin
  Result := FStartLineNumber;
end;

function TDomError.GetStartTabsInLine: Int64;
begin
  Result := FStartTabsInLine;
end;

function TDomError.GetUri: WideString;
begin
  Result := FUri;
end;



// ++++++++++++++++++++++++++++ TDomPERepository +++++++++++++++++++++++++++++
constructor TDomPERepository.Create(const AOwner: TXmlCustomReader);
begin
  if not Assigned(AOwner) then
    raise EAccessViolation.Create('AOwner not specified.');
  inherited Create;
  FOwner := AOwner;
  FPEMap := TDomOwnerNamedNodeMap.Create(TDomPEInfoObject);
end;

destructor TDomPERepository.Destroy;
begin
  FPEMap.Free;
  inherited;
end;

function TDomPERepository.Add(const Name,
                                    Value: WideString): Boolean;
var
  NewPEInfoObj: TDomPEInfoObject;
begin
  if not FPEMap.HasNamedItem(Name) then begin // Ignore declaration duplicates
    NewPEInfoObj := TDomPEInfoObject.Create(Self, Name, Value);
    try
      Result := True;
      FPEMap.Add(NewPEInfoObj);
    except
      NewPEInfoObj.Free;
      raise;
    end; {try ...}
  end else
    Result := False;
end;

function TDomPERepository.Add(const Name,
                                    BaseUri,
                                    PubId,
                                    SysId: WideString): Boolean;
var
  NewPEInfoObj: TDomPEInfoObject;
begin
  if not FPEMap.HasNamedItem(Name) then begin // Ignore declaration duplicates
    NewPEInfoObj := TDomPEInfoObject.CreateExtParsed(Self, Name, BaseUri, PubId, SysId);
    try
      Result := True;
      FPEMap.Add(NewPEInfoObj);
    except
      NewPEInfoObj.Free;
      raise;
    end; {try ...}
  end else
    Result := False;
end;

procedure TDomPERepository.Clear;
begin
  FPEMap.Clear;
end;

function TDomPERepository.ResolvePE(const Name: WideString;
                                    const AcceptExtEntity: Boolean;
                                      out Value,
                                          PubId,
                                          SysId: WideString): TXmlErrorType;
var
  PEInfoObject: TDomPEInfoObject;
begin
  if IsXmlName(Name) then begin
    PEInfoObject := FPEMap.GetNamedItem(Name) as TDomPEInfoObject;
    if Assigned(PEInfoObject) then begin

      // Update the literal value in case the parameter entity is external:
      if PEInfoObject.EntityType = etExternal_Entity then begin
        if AcceptExtEntity then begin
          if not PEInfoObject.UpdateAttempted then
            PEInfoObject.Update;
          Result := PEInfoObject.UpdateError;
        end else
          Result := ET_EXT_ENTITY_RESOURCE_NOT_FOUND;  // Return error, if external PEs are switched off.
      end else
        Result := ET_NONE;

      if Result in ET_WARNINGS then begin
        Value := PEInfoObject.LiteralValue;
        PubId := PEInfoObject.PublicId;
        SysId := PEInfoObject.EntityURI;
      end else begin
        Value := '';
        PubId := '';
        SysId := '';
        Exit;
      end;

    end else begin
      Value := '';
      PubId := '';
      SysId := '';
      Result := ET_UNDEFINED_PARAMETER_ENTITY;
    end;
  end else begin
    Value := '';
    PubId := '';
    SysId := '';
    Result := ET_INVALID_PARAMETER_ENTITY_NAME;
  end;
end;

procedure TDomPERepository.ResolveResourceAsWideString(const BaseURI,
                                                             PublicId,
                                                             SystemId: WideString;
                                                         out S: WideString;
                                                         out Error: TXmlErrorType);
begin
  OwnerReader.ResolveResourceAsWideString(BaseURI, PublicId, SystemId, S, Error);
end;



// ++++++++++++++++++++++ TDomPEInfoObject ++++++++++++++++++++++
constructor TDomPEInfoObject.Create(const AOwner: TDomPERepository;
                                    const EntityName,
                                          LitValue: WideString);
begin
  if not Assigned(AOwner) then
    raise EAccessViolation.Create('AOwner not specified.');
  if not IsXmlName(EntityName) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(nil);
  FOwnerRepository := AOwner;
  FUpdateAttempted := True;
  FUpdateError := ET_NONE;
  FEntityType := etInternal_Entity;
  try
    FLiteralValue := ResolveCharRefs(LitValue);
  except
    raise EInvalid_Character_Err.Create('Invalid character error.');
  end;
  FNodeName := EntityName;
  FPublicId := '';
  FSystemId := '';
end;

constructor TDomPEInfoObject.CreateExtParsed(const AOwner: TDomPERepository;
                                             const EntityName,
                                                   ABaseUri,
                                                   PubId,
                                                   SysId: WideString);
begin
  if not Assigned(AOwner) then
    raise EAccessViolation.Create('AOwner not specified.');
  if not IsXmlName(EntityName) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  if not IsXmlSystemChars(SysId) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  if not IsXmlPubidChars(PubId) then
    raise EInvalid_Character_Err.Create('Invalid character error.');
  inherited Create(nil);
  FBaseUri := ABaseUri;
  FOwnerRepository := AOwner;
  FEntityType := etExternal_Entity;
  FLiteralValue := '';
  FNodeName := EntityName;
  FPublicId := PubId;
  FSystemId := SysId;
  FUpdateError := ET_NONE;
  FUpdateAttempted := False;
end;

function TDomPEInfoObject.EntityURI: WideString;
begin
  // Calculate absolute system identifier:
  ResolveRelativeUriWideStr(BaseUri, SystemId, Result);
     // Remark: Returns an empty Result if ResolveRelativeUriWideStr attempt fails.
end;

function TDomPEInfoObject.GetNodeName: WideString;
begin
  Result := FNodeName;
end;

procedure TDomPEInfoObject.Update;
begin
  if EntityType = etExternal_Entity then begin
    FUpdateAttempted := True;
    OwnerRepository.ResolveResourceAsWideString(BaseURI, PublicId, SystemId,
                                                FLiteralValue, FUpdateError);
  end; 
end;



// +++++++++++++++++++++++++++++++ TXmlSignal +++++++++++++++++++++++++++++++
procedure TXmlSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                         out Flaw,
                                             Clue: WideString);
begin
  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';
end;

function TXmlSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := TXmlSignalClass(ClassType).Create(AReader, StartByteNumber,
              StartCharNumber, StartColumnNumber, StartLineNumber,
              StartTabsInLine, EndByteNumber, EndCharNumber, EndColumnNumber,
              EndLineNumber, EndTabsInLine, Uri, RelatedDtdObject, RelatedNode);
end;

constructor TXmlSignal.Create(const AReader: TXmlCustomReader;
                              const AStartByteNumber,
                                    AStartCharNumber,
                                    AStartColumnNumber,
                                    AStartLineNumber,
                                    AStartTabsInLine,
                                    AEndByteNumber,
                                    AEndCharNumber,
                                    AEndColumnNumber,
                                    AEndLineNumber,
                                    AEndTabsInLine: Int64;
                              const AUri: WideString;
                              const ARelatedDtdObject: TDtdObject;
                              const ARelatedNode: TDomNode);
begin
  inherited Create;

  FReader := AReader;

  FStartByteNumber :=   AStartByteNumber;
  FStartCharNumber :=   AStartCharNumber;
  FStartColumnNumber := AStartColumnNumber;
  FStartLineNumber :=   AStartLineNumber;
  FStartTabsInLine :=   AStartTabsInLine;
  FEndByteNumber :=     AEndByteNumber;
  FEndCharNumber :=     AEndCharNumber;
  FEndColumnNumber :=   AEndColumnNumber;
  FEndLineNumber :=     AEndLineNumber;
  FEndTabsInLine :=     AEndTabsInLine;
  FUri :=               AUri;
  FRelatedDtdObject :=  ARelatedDtdObject;
  FRelatedNode :=       ARelatedNode;
end;

constructor TXmlSignal.CreateFromLocator(const AReader: TXmlCustomReader;
                                         const Location: IDomLocator);
begin
  if Assigned(Location)
    then
      with Location do
        Self.Create(AReader, StartByteNumber, StartCharNumber, StartColumnNumber,
          StartLineNumber, StartTabsInLine, EndByteNumber, EndCharNumber,
          EndColumnNumber, EndLineNumber, EndTabsInLine, Uri, RelatedDtdObject,
          RelatedNode)
    else
      Create(AReader, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, '', nil, nil);
end;

function TXmlSignal.GetEndByteNumber: Int64;
begin
  Result := FEndByteNumber;
end;

function TXmlSignal.GetEndCharNumber: Int64;
begin
  Result := FEndCharNumber;
end;

function TXmlSignal.GetEndColumnNumber: Int64;
begin
  Result := FEndColumnNumber;
end;

function TXmlSignal.GetEndLineNumber: Int64;
begin
  Result := FEndLineNumber;
end;

function TXmlSignal.GetEndTabsInLine: Int64;
begin
  Result := FEndTabsInLine;
end;

function TXmlSignal.GetRelatedDtdObject: TDtdObject;
begin
  Result := FRelatedDtdObject;
end;

function TXmlSignal.GetRelatedNode: TDomNode;
begin
  Result := FRelatedNode;
end;

function TXmlSignal.GetStartByteNumber: Int64;
begin
  Result := FStartByteNumber;
end;

function TXmlSignal.GetStartCharNumber: Int64;
begin
  Result := FStartCharNumber;
end;

function TXmlSignal.GetStartColumnNumber: Int64;
begin
  Result := FStartColumnNumber;
end;

function TXmlSignal.GetStartLineNumber: Int64;
begin
  Result := FStartLineNumber;
end;

function TXmlSignal.GetStartTabsInLine: Int64;
begin
  Result := FStartTabsInLine;
end;

function TXmlSignal.GetUri: WideString;
begin
  Result := FUri;
end;

{ TXmlCompletedSignal }

function TXmlCompletedSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc, ssDtd];
end;

{ TXmlAbortedSignal }

function TXmlAbortedSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc, ssDtd];
end;

{ TXmlAttributeSignal }

procedure TXmlAttributeSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                  out Flaw,
                                                      Clue: WideString);
var
  CharacRef: WideString;
  I: Integer;
  InEntityRef: Boolean;
  Text: WideString;
  V: WideString;
begin
  if not IsXmlName(Name) then begin
    XmlErrorType := ET_INVALID_ATTRIBUTE_NAME;
    Flaw := Name;
    Clue := '';
    Exit;
  end;

  InEntityRef := False;
  Text := '';
  for I := 1 to Length(Value) do begin
    if InEntityRef then begin
      if Value[I] = ';' then begin
        if Text[1] = '#' then begin // CharRef
          try
            CharacRef := Concat(WideString('&'), Text, WideString(';'));
            V := XmlCharRefToStr(CharacRef);
          except
            on EConvertError do begin
              XmlErrorType := ET_INVALID_CHAR_REF;
              Flaw := CharacRef;
              Clue := '';
              Exit;
            end;
          end; {try}
        end else begin  // EntityRef
          if not IsXmlName(Text) then begin
            XmlErrorType := ET_INVALID_ENTITY_NAME;
            Flaw := Text;
            Clue := '';
            Exit;
          end;
        end;
        Text := '';
        InEntityRef := False;
      end else
        Text:= Concat(Text, WideString(Value[I]));
    end else begin
      if Value[I] = '&' then begin
        InEntityRef := True;
      end else if (Value[I] = '<') then begin
        // WFC: No < in Attribute Values (XML 1.0, § 3.3.2)
        XmlErrorType := ET_LT_IN_ATTRIBUTE_VALUE; 
        Flaw := Value[I];
        Clue := '';
        Exit;
      end else if not IsXmlChar(Value[I]) then begin
        XmlErrorType := ET_INVALID_ATTRIBUTE_VALUE;
        Flaw := Value[I];
        Clue := '';
        Exit;
      end;
    end; {if ...}
  end; {for I ...}

  if InEntityRef then begin
    if Length(Text) > 0 then begin
      if Text[1] = '#' then
        XmlErrorType := ET_UNCLOSED_CHAR_REF
      else
        XmlErrorType := ET_UNCLOSED_ENTITY_REF;
    end else
      XmlErrorType := ET_UNCLOSED_ENTITY_REF;
    Flaw := Value;
    Clue := '';
    Exit;
  end; {if ...}

  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';
end;

function TXmlAttributeSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlAttributeSignal(Result).DataType := DataType;
  TXmlAttributeSignal(Result).Name := Name;
  TXmlAttributeSignal(Result).Value := Value;
end;

function TXmlAttributeSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlCDATASignal }

procedure TXmlCDATASignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                              out Flaw,
                                                  Clue: WideString);
begin
  if IsXmlCData(Data)
    then XmlErrorType := ET_NONE
    else XmlErrorType := ET_INVALID_CDATA_SECTION;
  Flaw := '';
  Clue := '';
end;

function TXmlCDATASignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlCDATASignal(Result).Data := Data;
end;

function TXmlCDATASignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlDoctypeSignal }

procedure TXmlDoctypeSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                out Flaw,
                                                    Clue: WideString);
begin
  if not IsXmlName(DoctypeName) then begin
    XmlErrorType := ET_INVALID_ROOT_ELEMENT_NAME_IN_DOCTYPE_DECL;
    Flaw := DoctypeName;
    Clue := '';
  end else

  if not IsXmlPubidChars(PublicId) then begin
    XmlErrorType := ET_INVALID_PUBID_LITERAL;
    Flaw := PublicId;
    Clue := '';
  end else

  if not IsXmlSystemChars(SystemId)  then begin
    XmlErrorType := ET_INVALID_SYSTEM_LITERAL;
    Flaw := SystemId;
    Clue := '';

  end else begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end;
end;

function TXmlDoctypeSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlDoctypeSignal(Result).Data := Data;
  TXmlDoctypeSignal(Result).DoctypeName := DoctypeName;
  TXmlDoctypeSignal(Result).IntSubsetStartByteNumber := IntSubsetStartByteNumber;
  TXmlDoctypeSignal(Result).IntSubsetStartCharNumber := IntSubsetStartCharNumber;
  TXmlDoctypeSignal(Result).IntSubsetStartColumn := IntSubsetStartColumn;
  TXmlDoctypeSignal(Result).IntSubsetStartLine := IntSubsetStartLine;
  TXmlDoctypeSignal(Result).PublicId := PublicId;
  TXmlDoctypeSignal(Result).SystemId := SystemId;
end;

function TXmlDoctypeSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlEndElementSignal }

procedure TXmlEndElementSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                   out Flaw,
                                                       Clue: WideString);
begin
  if IsXmlName(TagName) then begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end else begin
    XmlErrorType := ET_INVALID_ELEMENT_NAME;
    Flaw := TagName;
    Clue := '';
  end;
end;

function TXmlEndElementSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlEndElementSignal(Result).TagName := TagName;
  TXmlEndElementSignal(Result).ShortForm := ShortForm;
end;

function TXmlEndElementSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlEndPrefixMappingSignal }

procedure TXmlEndPrefixMappingSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                         out Flaw,
                                                             Clue: WideString);
begin
  if IsXmlPrefix(Prefix) or (Prefix = '') then begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end else begin
    XmlErrorType := ET_INVALID_PREFIX;
    Flaw := Prefix;
    Clue := '';
  end;
end;

function TXmlEndPrefixMappingSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlEndPrefixMappingSignal(Result).Prefix := Prefix;
end;

function TXmlEndPrefixMappingSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlEntityRefSignal }

procedure TXmlEntityRefSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                  out Flaw,
                                                      Clue: WideString);
begin
  if IsXmlName(EntityName) then begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end else begin
    XmlErrorType := ET_INVALID_ENTITY_NAME;
    Flaw := EntityName;
    Clue := '';
  end;
end;

function TXmlEntityRefSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlEntityRefSignal(Result).EntityName := EntityName;
end;

function TXmlEntityRefSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlStartElementSignal }

procedure TXmlStartElementSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                     out Flaw,
                                                         Clue: WideString);
begin
  if IsXmlName(TagName) then begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end else begin
    XmlErrorType := ET_INVALID_ELEMENT_NAME;
    Flaw := TagName;
    Clue := '';
  end;
end;

function TXmlStartElementSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlStartElementSignal(Result).TagName := TagName;
end;

function TXmlStartElementSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlPCDATASignal }

constructor TXmlPCDATASignal.Create(const AReader: TXmlCustomReader;
                                    const AStartByteNumber,
                                          AStartCharNumber,
                                          AStartColumnNumber,
                                          AStartLineNumber,
                                          AStartTabsInLine,
                                          AEndByteNumber,
                                          AEndCharNumber,
                                          AEndColumnNumber,
                                          AEndLineNumber,
                                          AEndTabsInLine: Int64;
                                    const AUri: WideString;
                                    const ARelatedDtdObject: TDtdObject;
                                    const ARelatedNode: TDomNode);
begin
  inherited;
  FCharRefGenerated := False;
end;

procedure TXmlPCDATASignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                               out Flaw,
                                                   Clue: WideString);
begin
  if IsXmlCData(Data) then begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end else begin
    XmlErrorType := ET_INVALID_CHARACTER;
    Flaw := Data; 
    Clue := '';
  end;
end;

function TXmlPCDATASignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlPCDATASignal(Result).Data := Data;
  TXmlPCDATASignal(Result).CharRefGenerated := CharRefGenerated;
end;

function TXmlPCDATASignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlSkippedEntitySignal }

function TXmlSkippedEntitySignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlSkippedEntitySignal(Result).EntityName := EntityName;
end;

function TXmlSkippedEntitySignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlStartDocumentSignal }

procedure TXmlStartDocumentSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                      out Flaw,
                                                          Clue: WideString);
begin
  if not ( IsXmlEncName(EncodingName) or (EncodingName = '') ) then begin
    XmlErrorType := ET_INVALID_ENCODING_NAME;
    Flaw := '';
    Clue := '';
  end else

  if not ( IsXmlVersionNum(Version) or (Version = '') ) then begin
    XmlErrorType := ET_INVALID_VERSION_NUMBER;
    Flaw := '';
    Clue := '';

  end else begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end;
end;

function TXmlStartDocumentSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlStartDocumentSignal(Result).EncodingName := EncodingName;
  TXmlStartDocumentSignal(Result).InputEncoding := InputEncoding;
  TXmlStartDocumentSignal(Result).StandaloneDecl := StandaloneDecl;
  TXmlStartDocumentSignal(Result).Version := Version;
end;

function TXmlStartDocumentSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlStartDocumentFragmentSignal }

procedure TXmlStartDocumentFragmentSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                              out Flaw,
                                                                  Clue: WideString);
begin
  if not ( IsXmlEncName(EncodingName) or (EncodingName = '') ) then begin
    XmlErrorType := ET_INVALID_ENCODING_NAME;
    Flaw := '';
    Clue := '';
  end else begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end;;
end;

function TXmlStartDocumentFragmentSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlStartDocumentFragmentSignal(Result).EncodingName := EncodingName;
end;

function TXmlStartDocumentFragmentSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlStartPrefixMappingSignal }

procedure TXmlStartPrefixMappingSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                           out Flaw,
                                                               Clue: WideString);
const
  SQ: WideString = #39; // code of '
  DQ: WideString = #34; // code of "
begin
  if ( (Prefix = 'xmlns') and (Uri <> 'http://www.w3.org/2000/xmlns/') )
    or ( (Prefix <> '') and not isXmlPrefix(Prefix) ) then begin
    XmlErrorType := ET_INVALID_PREFIX;
    Flaw := Prefix;
    Clue := '';
  end else if not IsUriURI_referenceWideStr(Uri) then begin
    XmlErrorType := ET_INVALID_NAMESPACE_URI;
    Flaw := Uri;
    Clue := '';
  end else begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end;
end;

function TXmlStartPrefixMappingSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlStartPrefixMappingSignal(Result).Prefix := Prefix;
  TXmlStartPrefixMappingSignal(Result).Uri := Uri;
end;

function TXmlStartPrefixMappingSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc];
end;

{ TXmlCommentSignal }

procedure TXmlCommentSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                out Flaw,
                                                    Clue: WideString);
const
  HYPHEN: WideChar = #$2D; // Flaw of -
begin
  if Data <> '' then begin
    if Pos('--', Data) > 0 then begin
      XmlErrorType := ET_DOUBLE_HYPHEN_IN_COMMENT;
      Flaw := '--';
      Clue := '-';
      Exit;
    end else if Data[Length(Data)] = HYPHEN then begin
      XmlErrorType := ET_HYPHEN_AT_COMMENT_END;
      Flaw := '-';
      Clue := '';
      Exit;
    end else if not IsXmlChars(Data) then begin
      XmlErrorType := ET_INVALID_CHARACTER;
      Flaw := Data; 
      Clue := '';
      Exit;
    end;
  end;
  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';
end;

function TXmlCommentSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlCommentSignal(Result).Data := Data;
end;

function TXmlCommentSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc, ssDtd];
end;

{ TXmlProcessingInstructionSignal }

procedure TXmlProcessingInstructionSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                              out Flaw,
                                                                  Clue: WideString);
begin
  if not IsXmlPITarget(Target) then begin
    XmlErrorType := ET_INVALID_PROCESSING_INSTRUCTION;
    Flaw := Target;
    Clue := '';
  end else if Pos('?>', Data) > 0 then begin
    XmlErrorType := ET_INVALID_PROCESSING_INSTRUCTION;
    Flaw := '?>';
    Clue := '';
  end else if not IsXmlChars(Data) then begin
    XmlErrorType := ET_INVALID_CHARACTER;
    Flaw := Data; 
    Clue := '';
  end else begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end;
end;

function TXmlProcessingInstructionSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlProcessingInstructionSignal(Result).Data := Data;
  TXmlProcessingInstructionSignal(Result).Target := Target;
end;

function TXmlProcessingInstructionSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDoc, ssDtd];
end;

{ TXmlAttributeDefinitionSignal }

procedure TXmlAttributeDefinitionSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                            out Flaw,
                                                                Clue: WideString);
var
  CharacRef: WideString;
  I: Integer;
  InEntityRef: Boolean;
  Text: WideString;
  V: WideString;
begin
  if not IsXmlName(AttributeName) then begin
    XmlErrorType := ET_INVALID_ATTRIBUTE_NAME_IN_ATTRIBUTE_DECL;
    Flaw := AttributeName;
    Clue := '';
    Exit;
  end;

  if not IsXmlName(ElementName) then begin
    XmlErrorType := ET_INVALID_ELEMENT_NAME_IN_ATTRIBUTE_DECL; 
    Flaw := ElementName;
    Clue := '';
    Exit;
  end;

  if AttributeType = AS_NOTATION_DATATYPE then begin
    for I := 0 to Pred(Enumeration.Count) do
      if not IsXmlName(Enumeration[I]) then begin
        XmlErrorType := ET_INVALID_NOTATION_TOKEN_IN_ATTRIBUTE_DECL;
        Flaw := Enumeration[I];
        Clue := '';
        Exit;
      end;
  end else begin
    for I := 0 to Pred(Enumeration.Count) do
      if not IsXmlNmtoken(Enumeration[I]) then begin
        XmlErrorType := ET_INVALID_ENUMERATION_TOKEN_IN_ATTRIBUTE_DECL;
        Flaw := Enumeration[I];
        Clue := '';
        Exit;
      end;
  end;

  // Check default value:
  InEntityRef := False;
  Text := '';
  for I := 1 to Length(DefaultValue) do begin
    if InEntityRef then begin
      if DefaultValue[I] = ';' then begin
        if Text[1] = '#' then begin // CharRef
          try
            CharacRef := Concat(WideString('&'), Text, WideString(';'));
            V := XmlCharRefToStr(CharacRef);
          except
            on EConvertError do begin
              XmlErrorType := ET_INVALID_CHAR_REF;
              Flaw := CharacRef;
              Clue := '';
              Exit;
            end;
          end; {try}
        end else begin  // EntityRef
          if not IsXmlName(Text) then begin
            XmlErrorType := ET_INVALID_ENTITY_NAME;
            Flaw := Text;
            Clue := '';
            Exit;
          end;
        end;
        Text := '';
        InEntityRef := False;
      end else
        Text:= Concat(Text, WideString(DefaultValue[I]));
    end else begin
      if DefaultValue[I] = '&' then begin
        InEntityRef := True;
      end else if (DefaultValue[I] = '<') then begin
        // WFC: No < in Attribute Values (XML 1.0, § 3.3.2), etc.
        XmlErrorType := ET_LT_IN_ATTRIBUTE_VALUE;
        Flaw := DefaultValue[I];
        Clue := '';
        Exit;
      end else if not IsXmlChar(DefaultValue[I]) then begin
        XmlErrorType := ET_INVALID_ATTRIBUTE_VALUE;
        Flaw := DefaultValue[I];
        Clue := '';
        Exit;
      end;
    end; {if ...}
  end; {for ...}

  if InEntityRef then begin
    if Length(Text) > 0 then begin
      if Text[1] = '#' then
        XmlErrorType := ET_UNCLOSED_CHAR_REF
      else
        XmlErrorType := ET_UNCLOSED_ENTITY_REF;
    end else
      XmlErrorType := ET_UNCLOSED_ENTITY_REF;
    Flaw := DefaultValue;
    Clue := '';
    Exit;
  end; {if ...}

  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';
end;

function TXmlAttributeDefinitionSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlAttributeDefinitionSignal(Result).AttributeName := AttributeName;
  TXmlAttributeDefinitionSignal(Result).AttributeType := AttributeType;
  TXmlAttributeDefinitionSignal(Result).Constraint := Constraint;
  TXmlAttributeDefinitionSignal(Result).DefaultValue := DefaultValue;
  TXmlAttributeDefinitionSignal(Result).ElementName := ElementName;
  TXmlAttributeDefinitionSignal(Result).Enumeration := Enumeration;
  TXmlAttributeDefinitionSignal(Result).IsDeclaredInPE := IsDeclaredInPE;
end;

constructor TXmlAttributeDefinitionSignal.Create(const AReader: TXmlCustomReader;
                                                 const AStartByteNumber,
                                                       AStartCharNumber,
                                                       AStartColumnNumber,
                                                       AStartLineNumber,
                                                       AStartTabsInLine,
                                                       AEndByteNumber,
                                                       AEndCharNumber,
                                                       AEndColumnNumber,
                                                       AEndLineNumber,
                                                       AEndTabsInLine: Int64;
                                                 const AUri: WideString;
                                                 const ARelatedDtdObject: TDtdObject;
                                                 const ARelatedNode: TDomNode);
begin
  inherited;
  FEnumeration := TUtilsWideStringList.Create;
end;

destructor TXmlAttributeDefinitionSignal.Destroy;
begin
  FEnumeration.Free;
  inherited;
end;

function TXmlAttributeDefinitionSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

procedure TXmlAttributeDefinitionSignal.SetEnumeration(const Value: TUtilsWideStringList);
begin
  FEnumeration.Assign(Value);
end;

{ TXmlElementTypeDeclarationSignal }

procedure TXmlElementTypeDeclarationSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                               out Flaw,
                                                                   Clue: WideString);
  type
    TXmlParsedElementCMTokenType = (
      DTD_PECM_CHOICE_TOKEN,
      DTD_PECM_CHOICE_NAME_TOKEN,
      DTD_PECM_CLOSING_BRACKET_TOKEN,
      DTD_PECM_END_TOKEN,
      DTD_PECM_FREQUENCY_TOKEN,
      DTD_PECM_NAME_TOKEN,
      DTD_PECM_OPENING_BRACKET_TOKEN,
      DTD_PECM_PCDATA_TOKEN,
      DTD_PECM_PCDATA_CHOICE_TOKEN,
      DTD_PECM_PCDATA_NAME_BRACKET_TOKEN,
      DTD_PECM_PCDATA_NAME_TOKEN,
      DTD_PECM_PCDATA_ONLY_BRACKET_TOKEN,
      DTD_PECM_START_TOKEN,
      DTD_PECM_SEQUENCE_TOKEN,
      DTD_PECM_SEQUENCE_NAME_TOKEN
    );

  function ReplacePrecedingBracket(const Stack: TStack): TXmlErrorType;
  // Replaces a preceding bracket, if any.
  begin
    Result := ET_NONE;
    if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_CLOSING_BRACKET_TOKEN then begin
      // Completely remove the last bracket ...
      repeat
        Stack.Pop;
      until TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_OPENING_BRACKET_TOKEN;
      Stack.Pop;
      // ... and replace it with an appropriate faked element name token:
      case TXmlParsedElementCMTokenType(Stack.Peek) of
        DTD_PECM_OPENING_BRACKET_TOKEN:
          Stack.Push(Pointer(DTD_PECM_NAME_TOKEN));
        DTD_PECM_CHOICE_TOKEN:
          Stack.Push(Pointer(DTD_PECM_CHOICE_NAME_TOKEN));
        DTD_PECM_SEQUENCE_TOKEN:
          Stack.Push(Pointer(DTD_PECM_SEQUENCE_NAME_TOKEN));
      else
        Result := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
      end;
    end;
  end;

var
  Tokenizer: TXmlElementCMTokenizer;
  Stack: TStack;
begin
  // Check element name:
  if not IsXmlName(ElementName) then begin
    XmlErrorType := ET_INVALID_ELEMENT_NAME_IN_ELEMENT_DECL;
    Flaw := ElementName;
    Clue := '';
    Exit;
  end;

  // Check content model:
  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';
  Stack := TStack.Create;
  try
    Tokenizer := TXmlElementCMTokenizer.Create(Data);
    try
      while True do begin

        case Tokenizer.TokenType of
          DTD_ECM_START_OF_SOURCE_TOKEN: begin
            // Initialize the stack:
            Stack.Push(Pointer(DTD_PECM_START_TOKEN));
          end;

          DTD_ECM_ANY_KEYWORD_TOKEN:
            if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_START_TOKEN then begin
              Stack.Push(Pointer(DTD_PECM_END_TOKEN));
            end else begin
              XmlErrorType := ET_KEYWORD_ANY_NOT_ALLOWED;
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

          DTD_ECM_EMPTY_KEYWORD_TOKEN:
            if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_START_TOKEN then begin
              Stack.Push(Pointer(DTD_PECM_END_TOKEN));
            end else begin
              XmlErrorType := ET_KEYWORD_EMPTY_NOT_ALLOWED;
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

          DTD_ECM_PCDATA_KEYWORD_TOKEN:
            if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_OPENING_BRACKET_TOKEN then begin
              Stack.Push(Pointer(DTD_PECM_PCDATA_TOKEN));
            end else begin
              XmlErrorType := ET_KEYWORD_PCDATA_NOT_ALLOWED;
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

          DTD_ECM_OPENING_BRACKET_TOKEN:
            if TXmlParsedElementCMTokenType(Stack.Peek)
                 in [ DTD_PECM_CHOICE_TOKEN,
                      DTD_PECM_OPENING_BRACKET_TOKEN,
                      DTD_PECM_START_TOKEN,
                      DTD_PECM_SEQUENCE_TOKEN ]

            then begin
              Stack.Push(Pointer(DTD_PECM_OPENING_BRACKET_TOKEN));
            end else begin
              XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

          DTD_ECM_CLOSING_BRACKET_TOKEN: begin
            if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_FREQUENCY_TOKEN then
              Stack.Pop;  // Pop optional preceding frequency operator.

            if TXmlParsedElementCMTokenType(Stack.Peek)
                 in [ DTD_PECM_CHOICE_TOKEN,
                      DTD_PECM_END_TOKEN,
                      DTD_PECM_OPENING_BRACKET_TOKEN,
                      DTD_PECM_PCDATA_CHOICE_TOKEN,
                      DTD_PECM_PCDATA_NAME_BRACKET_TOKEN,
                      DTD_PECM_PCDATA_ONLY_BRACKET_TOKEN,
                      DTD_PECM_START_TOKEN,
                      DTD_PECM_SEQUENCE_TOKEN ]
            then begin
              XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

            if ReplacePrecedingBracket(Stack) <> ET_NONE then begin
              XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

            case TXmlParsedElementCMTokenType(Stack.Peek) of
              DTD_PECM_PCDATA_TOKEN:
                Stack.Push(Pointer(DTD_PECM_PCDATA_ONLY_BRACKET_TOKEN));
              DTD_PECM_PCDATA_NAME_TOKEN:
                Stack.Push(Pointer(DTD_PECM_PCDATA_NAME_BRACKET_TOKEN));
            else
              Stack.Push(Pointer(DTD_PECM_CLOSING_BRACKET_TOKEN));
            end;
          end;

          DTD_ECM_NAME_TOKEN:
            case TXmlParsedElementCMTokenType(Stack.Peek) of
              DTD_PECM_CHOICE_TOKEN:
                Stack.Push(Pointer(DTD_PECM_CHOICE_NAME_TOKEN));
              DTD_PECM_OPENING_BRACKET_TOKEN:
                Stack.Push(Pointer(DTD_PECM_NAME_TOKEN));
              DTD_PECM_PCDATA_CHOICE_TOKEN:
                Stack.Push(Pointer(DTD_PECM_PCDATA_NAME_TOKEN));
              DTD_PECM_SEQUENCE_TOKEN:
                Stack.Push(Pointer(DTD_PECM_SEQUENCE_NAME_TOKEN));
            else
              XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL; 
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

          DTD_ECM_SEPARATOR_TOKEN: begin
            if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_FREQUENCY_TOKEN then
              Stack.Pop;  // Pop optional preceding frequency operator.
            if ReplacePrecedingBracket(Stack) <> ET_NONE then begin
              XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL; 
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;
            if Tokenizer.TokenValue = ',' then begin
              case TXmlParsedElementCMTokenType(Stack.Peek) of
                DTD_PECM_NAME_TOKEN, DTD_PECM_SEQUENCE_NAME_TOKEN:
                  Stack.Push(Pointer(DTD_PECM_SEQUENCE_TOKEN));
              else
                XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
                Flaw := Tokenizer.TokenValue;
                Clue := '';
                Exit;
              end;
            end else begin  // Tokenizer.TokenValue = '|'
              case TXmlParsedElementCMTokenType(Stack.Peek) of
                DTD_PECM_NAME_TOKEN,
                DTD_PECM_CHOICE_NAME_TOKEN:
                  Stack.Push(Pointer(DTD_PECM_CHOICE_TOKEN));
                DTD_PECM_PCDATA_TOKEN,
                DTD_PECM_PCDATA_NAME_TOKEN,
                DTD_PECM_PCDATA_CHOICE_TOKEN:
                  Stack.Push(Pointer(DTD_PECM_PCDATA_CHOICE_TOKEN));
              else
                XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL; 
                Flaw := Tokenizer.TokenValue;
                Clue := '';
                Exit;
              end;
            end;
          end;

          DTD_ECM_FREQUENCY_TOKEN:
            case TXmlParsedElementCMTokenType(Stack.Peek) of
              DTD_PECM_CHOICE_NAME_TOKEN,
              DTD_PECM_CLOSING_BRACKET_TOKEN,
              DTD_PECM_NAME_TOKEN,
              DTD_PECM_SEQUENCE_NAME_TOKEN:
                Stack.Push(Pointer(DTD_PECM_FREQUENCY_TOKEN));
              DTD_PECM_PCDATA_NAME_BRACKET_TOKEN,
              DTD_PECM_PCDATA_ONLY_BRACKET_TOKEN:
                if Tokenizer.TokenValue = '*' then begin
                  Stack.Push(Pointer(DTD_PECM_END_TOKEN));
                end else begin
                  XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
                  Flaw := Tokenizer.TokenValue;
                  Clue := '';
                  Exit;
                end;
            else
              XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
              Flaw := Tokenizer.TokenValue;
              Clue := '';
              Exit;
            end;

          DTD_ECM_END_OF_SOURCE_TOKEN: begin
            if not ( TXmlParsedElementCMTokenType(Stack.Peek)
                       in [ DTD_PECM_END_TOKEN,
                            DTD_PECM_PCDATA_ONLY_BRACKET_TOKEN ] )

            then begin
              if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_FREQUENCY_TOKEN then
                Stack.Pop;  // Pop optional preceding frequency operator.
              if TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_CLOSING_BRACKET_TOKEN then begin
                // Completely remove the last bracket ...
                repeat
                  Stack.Pop;
                until TXmlParsedElementCMTokenType(Stack.Peek) = DTD_PECM_OPENING_BRACKET_TOKEN;
                Stack.Pop;
                // ... and check whether something remains on the stack:
                if TXmlParsedElementCMTokenType(Stack.Peek) <> DTD_PECM_START_TOKEN then begin
                  XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;
                  Flaw := Tokenizer.TokenValue;
                  Clue := '';
                  Exit;
                end;
              end else begin
                XmlErrorType := ET_MALFORMED_CONTENT_MODEL_IN_ELEMENT_DECL;  
                Flaw := Tokenizer.TokenValue;
                Clue := '';
                Exit;
              end;
            end;
            Exit;
          end;

        end; {case ...}

        Tokenizer.Next;

        if Tokenizer.ErrorType in ET_FATAL_ERRORS then begin
          XmlErrorType := Tokenizer.ErrorType;
          Flaw := Tokenizer.TokenValue;
          Clue := Tokenizer.Clue;
          Exit;
        end;

      end; {while ...}
    finally
      Tokenizer.Free;
    end;
  finally
    Stack.Free;
  end;
end;

function TXmlElementTypeDeclarationSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlElementTypeDeclarationSignal(Result).Data := Data;
  TXmlElementTypeDeclarationSignal(Result).ElementName := ElementName;
  TXmlElementTypeDeclarationSignal(Result).IsDeclaredInPE := IsDeclaredInPE;
end;

function TXmlElementTypeDeclarationSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

{ TXmlEntityDeclarationSignal }

procedure TXmlEntityDeclarationSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                          out Flaw,
                                                              Clue: WideString);
begin
  if not IsXmlName(EntityName) then begin
    XmlErrorType := ET_INVALID_ENTITY_NAME_IN_ENTITY_DECL;
    Flaw := EntityName;
    Clue := '';
    Exit;
  end;
  if EntityValue <> '' then begin
    if not IsXmlEntityValueChars(EntityValue) then begin
      XmlErrorType := ET_INVALID_ENTITY_VALUE_IN_ENTITY_DECL;
      Flaw := EntityValue;
      Clue := '';
      Exit;
    end;
    if not ( (PublicId = '') and
             (SystemId = '') and
             (NotationName = '') ) then begin
      XmlErrorType := ET_MISSING_ENTITY_VALUE_IN_ENTITY_DECL;
      Flaw := '';
      Clue := '';
      Exit;
    end;
  end;
  if not IsXmlSystemChars(SystemId) then begin
    XmlErrorType := ET_INVALID_SYSTEM_LITERAL;
    Flaw := SystemId;
    Clue := '';
    Exit;
  end;
  if not IsXmlPubidChars(PublicId) then begin
    XmlErrorType := ET_INVALID_PUBID_LITERAL;  
    Flaw := PublicId;
    Clue := '';
    Exit;
  end;
  if (NotationName <> '') and (not IsXmlName(NotationName)) then begin
    XmlErrorType := ET_INVALID_NOTATION_NAME_IN_ENTITY_DECL;
    Flaw := NotationName;
    Clue := '';
    Exit;
  end;

  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';
end;

function TXmlEntityDeclarationSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlEntityDeclarationSignal(Result).BaseUri := BaseUri;
  TXmlEntityDeclarationSignal(Result).EntityName := EntityName;
  TXmlEntityDeclarationSignal(Result).EntityValue := EntityValue;
  TXmlEntityDeclarationSignal(Result).IsDeclaredInPE := IsDeclaredInPE;
  TXmlEntityDeclarationSignal(Result).NotationName := NotationName;
  TXmlEntityDeclarationSignal(Result).PublicId := PublicId;
  TXmlEntityDeclarationSignal(Result).SystemId := SystemId;
end;

function TXmlEntityDeclarationSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

{ TXmlExternalPEReferenceSignal }

procedure TXmlExternalPEReferenceSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                            out Flaw, Clue: WideString);
begin
  if IsXmlName(ParameterEntityName) then begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end else begin
    XmlErrorType := ET_INVALID_PARAMETER_ENTITY_NAME;
    Flaw := ParameterEntityName;
    Clue := '';
  end;
end;

function TXmlExternalPEReferenceSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlExternalPEReferenceSignal(Result).ParameterEntityName := ParameterEntityName;
end;

function TXmlExternalPEReferenceSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

{ TXmlNotationDeclarationSignal }

procedure TXmlNotationDeclarationSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                            out Flaw,
                                                                Clue: WideString);
begin
  if not IsXmlName(NotationName) then begin
    XmlErrorType := ET_INVALID_NOTATION_NAME_IN_NOTATION_DECL; 
    Flaw := NotationName;
    Clue := '';
  end else if not IsXmlSystemChars(SystemId) then begin
    XmlErrorType := ET_INVALID_SYSTEM_LITERAL;
    Flaw := SystemId;
    Clue := '';
  end else if not IsXmlPubidChars(PublicId) then begin
    XmlErrorType := ET_INVALID_PUBID_LITERAL;  
    Flaw := PublicId;
    Clue := '';
  end else begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end;
end;

function TXmlNotationDeclarationSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlNotationDeclarationSignal(Result).IsDeclaredInPE := IsDeclaredInPE;
  TXmlNotationDeclarationSignal(Result).NotationName := NotationName;
  TXmlNotationDeclarationSignal(Result).PublicId := PublicId;
  TXmlNotationDeclarationSignal(Result).SystemId := SystemId;
end;

function TXmlNotationDeclarationSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

{ TXmlParameterEntityDeclarationSignal }

procedure TXmlParameterEntityDeclarationSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                                   out Flaw,
                                                                       Clue: WideString);
begin
  if not IsXmlName(EntityName) then begin
    XmlErrorType := ET_INVALID_ENTITY_NAME_IN_PARAMETER_ENTITY_DECL;
    Flaw := EntityName;
    Clue := '';
    Exit;
  end;
  if EntityValue <> '' then begin
    if not IsXmlEntityValueChars(EntityValue) then begin
      XmlErrorType := ET_INVALID_ENTITY_VALUE_IN_PARAMETER_ENTITY_DECL; 
      Flaw := EntityValue;
      Clue := '';
      Exit;
    end;
    if not ( (PublicId = '') and
             (SystemId = '') ) then begin
      XmlErrorType := ET_MISSING_ENTITY_VALUE_IN_PARAMETER_ENTITY_DECL;
      Flaw := '';
      Clue := '';
      Exit;
    end;
  end;
  if not IsXmlSystemChars(SystemId) then begin
    XmlErrorType := ET_INVALID_SYSTEM_LITERAL;
    Flaw := SystemId;
    Clue := '';
    Exit;
  end;
  if not IsXmlPubidChars(PublicId) then begin
    XmlErrorType := ET_INVALID_PUBID_LITERAL;  
    Flaw := PublicId;
    Clue := '';
    Exit;
  end;

  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';
end;

function TXmlParameterEntityDeclarationSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlParameterEntityDeclarationSignal(Result).BaseUri := BaseUri;
  TXmlParameterEntityDeclarationSignal(Result).EntityName := EntityName;
  TXmlParameterEntityDeclarationSignal(Result).EntityValue := EntityValue;
  TXmlParameterEntityDeclarationSignal(Result).PublicId := PublicId;
  TXmlParameterEntityDeclarationSignal(Result).SystemId := SystemId;
end;

function TXmlParameterEntityDeclarationSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

{ TXmlPEReferenceFoundSignal }

function TXmlPEReferenceFoundSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

{ TXmlStartExtDtdSignal }

procedure TXmlStartExtDtdSignal.CheckWellformedness(out XmlErrorType: TXmlErrorType;
                                                    out Flaw,
                                                        Clue: WideString);
begin
  if not ( IsXmlEncName(EncodingName) or (EncodingName = '') ) then begin
    XmlErrorType := ET_INVALID_ENCODING_NAME;
    Flaw := '';
    Clue := '';
  end else

  if not ( IsXmlVersionNum(Version) or (Version = '') ) then begin
    XmlErrorType := ET_INVALID_VERSION_NUMBER;
    Flaw := '';
    Clue := '';

  end else begin
    XmlErrorType := ET_NONE;
    Flaw := '';
    Clue := '';
  end;
end;

function TXmlStartExtDtdSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlStartExtDtdSignal(Result).EncodingName := EncodingName;
  TXmlStartExtDtdSignal(Result).InputEncoding := InputEncoding;
  TXmlStartExtDtdSignal(Result).PublicId := PublicId;
  TXmlStartExtDtdSignal(Result).SystemId := SystemId;
  TXmlStartExtDtdSignal(Result).Version := Version;
end;

function TXmlStartExtDtdSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;

{ TXmlStartIntDtdSignal }

function TXmlStartIntDtdSignal.CloneSignal(const AReader: TXmlCustomReader): TXmlSignal;
begin
  Result := inherited CloneSignal(AReader);
  TXmlStartIntDtdSignal(Result).SystemId := SystemId;
  TXmlStartIntDtdSignal(Result).XmlStandalone := XmlStandalone;
end;

function TXmlStartIntDtdSignal.Scope: TXmlSignalScope;
begin
  Result := [ssDtd];
end;



// ++++++++++++++++++++++++++++ TXmlCustomHandler ++++++++++++++++++++++++++++
procedure TXmlCustomHandler.SendErrorNotification(const Target: TXmlCustomReader;
                                                  const XmlErrorType: TXmlErrorType;
                                                  const Location: IDomLocator;
                                                  const Code,
                                                        Clue: WideString);
begin
  if Assigned(Target) then begin
    Target.SendErrorNotification(XmlErrorType, Location, Code, Clue);
  end else if XmlErrorType in ET_FATAL_ERRORS then begin
    raise EParserException.Create('Signal Processing Exception');
  end;
end;



// +++++++++++++++++++++++++++ TXmlStandardHandler +++++++++++++++++++++++++++
procedure TXmlStandardHandler.Notification(AComponent: TComponent;
                                           Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FNextHandler)
    then FNextHandler := nil;
end;

procedure TXmlStandardHandler.ProcessSignal(const Signal: TXmlSignal);
var
  Accept: Boolean;
begin
  Accept := True;
  if Assigned(FOnSignal) then
    FOnSignal(Self, Signal, Accept);
  if Accept and Assigned(NextHandler) then
    NextHandler.ProcessSignal(Signal);
  if Assigned(FOnSignaled) then
    FOnSignaled(Self, Signal);
end;



// +++++++++++++++++++++++++++++ TXmlHandlerItem +++++++++++++++++++++++++++++
function TXmlHandlerItem.GetXmlHandler: TXmlCustomHandler;
begin
  Result := FXmlHandler;
end;

procedure TXmlHandlerItem.SetXmlHandler(Value: TXmlCustomHandler);
begin
  FXmlHandler := Value;
end;

procedure TXmlHandlerItem.Assign(Source: TPersistent);
begin
  if Source is TXmlHandlerItem
    then XmlHandler := TXmlHandlerItem(Source).XmlHandler
    else inherited Assign(Source);
end;


// +++++++++++++++++++++++++++++++ TXmlHandlers ++++++++++++++++++++++++++++++
constructor TXmlHandlers.Create(Distributor: TXmlDistributor);
begin
  inherited Create(TXmlHandlerItem);
  FDistributor := Distributor;
end;

function TXmlHandlers.GetItem(Index: Integer): TXmlHandlerItem;
begin
  Result := TXmlHandlerItem(inherited GetItem(Index));
end;

procedure TXmlHandlers.SetItem(Index: Integer; Value: TXmlHandlerItem);
begin
  inherited SetItem(Index, Value);
end;

function TXmlHandlers.GetOwner: TPersistent;
begin
  Result := FDistributor;
end;

function TXmlHandlers.Add: TXmlHandlerItem;
begin
  Result := TXmlHandlerItem(inherited Add);
end;

procedure TXmlHandlers.Assign(Source: TPersistent);
var
  I : Integer;
begin
  if Source = Self then Exit;
  if Source is TStrings then begin
    Clear;
    with TStrings(Source) do
      for I := 0 to Pred(Count) do
        if Assigned(Objects[I]) then
          if Objects[I] is TXmlCustomHandler then
            Self.Add.XmlHandler := TXmlCustomHandler(Objects[I]);
  end else inherited Assign(Source);
end;

function TXmlHandlers.FindHandlerItem(AHandler: TXmlCustomHandler): TXmlHandlerItem;
var
  I: Integer;
begin
  for I := 0 to Pred(Count) do
  begin
    Result := TXmlHandlerItem(inherited GetItem(I));
    if Result.FXmlHandler = AHandler then Exit;
  end;
  Result := nil;
end;



// +++++++++++++++++++++++++++++ TXmlDistributor +++++++++++++++++++++++++++++
constructor TXmlDistributor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDisableCount := 0;
  FNextHandlers := TXmlHandlers.Create(Self);
end;

destructor TXmlDistributor.Destroy;
begin
  FNextHandlers.Free;
  inherited Destroy;
end;

procedure TXmlDistributor.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  // Advice the Filer to read or write the NextHandlers collection as if it
  // were a property:
  Filer.DefineProperty('NextHandlers', ReadData, WriteData, True);
end;

procedure TXmlDistributor.Notification(AComponent: TComponent;
                                       Operation: TOperation);
var
  HandlerItem: TXmlHandlerItem;
begin
  inherited Notification(AComponent, Operation);
  if not (csDestroying in ComponentState) and (Operation = opRemove) then begin
    if (AComponent is TXmlCustomHandler) then  begin
      HandlerItem := NextHandlers.FindHandlerItem(TXmlCustomHandler(AComponent));
      if HandlerItem <> nil then HandlerItem.XmlHandler := nil;
    end;
  end;
end;

procedure TXmlDistributor.ProcessSignal(const Signal: TXmlSignal);
var
  I: Integer;
  Ok: Boolean;
  SignalCopy: TXmlSignal;
begin
  OK := True;
  with NextHandlers do begin
    for I := 0 to Pred(Count) do begin
      if not Assigned(Items[I].XmlHandler) then Continue;
      SignalCopy := Signal.CloneSignal(Signal.Reader);  // We use a copy of the signal,
      try                                               // because subsequent Signal Handlers
        Items[I].XmlHandler.ProcessSignal(SignalCopy);  // might change the signal's properties.
      except
        Ok := False;
      end;
      SignalCopy.Free;
    end;
  end;
  if not Ok then
    raise EParserException.Create('Signal Processing Exception');
end;

procedure TXmlDistributor.ReadData(Reader: TReader);
begin
  Reader.ReadCollection(NextHandlers);
end;

procedure TXmlDistributor.SetNextHandlers(const Value: TXmlHandlers);
begin
  FNextHandlers.Assign(Value);
end;

procedure TXmlDistributor.WriteData(Writer: TWriter);
begin
  Writer.WriteCollection(NextHandlers);
end;



// +++++++++++++++++++++++ TXmlWFTestHandler +++++++++++++++++++++++
constructor TXmlWFTestHandler.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActivityStatus := asInactive;
  FDoctypeFound := False;
  FPrefixStack := TUtilsWideStringList.Create;
  FRootProcessingStatus := rsBeforeRoot;
  FTagStack := TUtilsWideStringList.Create;
end;

destructor TXmlWFTestHandler.Destroy;
begin
  FPrefixStack.Free;
  FTagStack.Free;
  inherited Destroy;
end;

procedure TXmlWFTestHandler.ProcessSignal(const Signal: TXmlSignal);

  procedure CheckDoctypeSignal(const DoctypeSignal: TXmlDoctypeSignal;
                                 var AXmlErrorType:  TXmlErrorType;
                                 var AFlaw: WideString);
  begin
    if FDoctypeFound then begin
      AXmlErrorType := ET_DOUBLE_DOCTYPE;
      AFlaw := DoctypeSignal.DoctypeName;
    end else begin;
      FDoctypeFound := True;
      if FRootProcessingStatus <> rsBeforeRoot then begin
        AXmlErrorType := ET_WRONG_ORDER;
        AFlaw := DoctypeSignal.DoctypeName;
      end;
    end;
  end;

  procedure CheckEndElementSignal(const EndElementSignal: TXmlEndElementSignal;
                                    var AXmlErrorType:  TXmlErrorType;
                                    var AFlaw: WideString);
  var
    LastItemIndex: Integer;
  begin
    LastItemIndex := Pred(FTagStack.Count);
    if LastItemIndex = -1 then begin
      AXmlErrorType := ET_MISSING_START_TAG;
      AFlaw := EndElementSignal.TagName;
    end else begin
      if FTagStack[LastItemIndex] = EndElementSignal.TagName then begin
        FTagStack.Delete(LastItemIndex);
        if LastItemIndex = 0 then
          FRootProcessingStatus := rsAfterRoot;
      end else begin
        AXmlErrorType := ET_MISSING_START_TAG;
        AFlaw := EndElementSignal.TagName;
      end;
    end;
  end;

  procedure CheckEndPrefixMappingSignal(const EndPrefixMappingSignal: TXmlEndPrefixMappingSignal;
                                          var AXmlErrorType:  TXmlErrorType;
                                          var AFlaw: WideString);
  var
    L: Integer;
  begin
    L := Pred(FPrefixStack.Count);
    if L = -1 then begin
      AXmlErrorType := ET_WRONG_PREFIX_MAPPING_NESTING;
      AFlaw := EndPrefixMappingSignal.Prefix;
    end else begin
      if FPrefixStack[L] <> EndPrefixMappingSignal.Prefix then begin
        AXmlErrorType := ET_WRONG_PREFIX_MAPPING_NESTING;
        AFlaw := EndPrefixMappingSignal.Prefix;
      end else
        FPrefixStack.Delete(L);
    end;
  end;

  function LastOpenTag: WideString;
  var
    LastItemIndex: Integer;
  begin
    LastItemIndex := Pred(FTagStack.Count);
    if LastItemIndex = -1
      then Result := ''
      else Result := FTagStack[LastItemIndex];
  end;

var
  Flaw, Clue: WideString;
  XmlErrorType: TXmlErrorType;
begin
  XmlErrorType := ET_NONE;
  Flaw := '';
  Clue := '';

  case FActivityStatus of

    asDocActive: begin

      if Signal is TXmlCDATASignal then begin
        if FRootProcessingStatus <> rsInRoot then begin
          XmlErrorType := ET_NOT_IN_ROOT_ELEMENT;
          Flaw := TXmlCDATASignal(Signal).Data;
        end;
      end else

      if Signal is TXmlDoctypeSignal then begin
        CheckDoctypeSignal(TXmlDoctypeSignal(Signal), XmlErrorType, Flaw);
      end else

      if Signal is TXmlEndElementSignal then begin
        CheckEndElementSignal(TXmlEndElementSignal(Signal), XmlErrorType, Flaw);
      end else

      if Signal is TXmlEntityRefSignal then begin
        if FRootProcessingStatus <> rsInRoot then begin
          XmlErrorType := ET_NOT_IN_ROOT_ELEMENT;
          Flaw := Concat('&',TXmlEntityRefSignal(Signal).EntityName,';');
        end;
      end else

      if Signal is TXmlPCDATASignal then begin
        if FRootProcessingStatus <> rsInRoot then begin
          if TXmlPCDATASignal(Signal).CharRefGenerated then begin
            XmlErrorType := ET_NOT_IN_ROOT_ELEMENT;
            Flaw := '&#';
          end else if not IsXmlS(TXmlPCDATASignal(Signal).Data) then begin
            XmlErrorType := ET_NOT_IN_ROOT_ELEMENT;
            Flaw := TXmlPCDATASignal(Signal).Data;
          end;
        end;
      end else

      if Signal is TXmlStartElementSignal then begin
        if FRootProcessingStatus = rsAfterRoot then begin
          XmlErrorType := ET_DOUBLE_ROOT_ELEMENT;
          Flaw := TXmlStartElementSignal(Signal).TagName;
        end else begin
          FRootProcessingStatus := rsInRoot;
          FTagStack.Add(TXmlStartElementSignal(Signal).TagName);
        end;
      end else

      if Signal is TXmlStartPrefixMappingSignal then begin
        FPrefixStack.Add(TXmlStartPrefixMappingSignal(Signal).Prefix);
      end else

      if Signal is TXmlEndPrefixMappingSignal then begin
        CheckEndPrefixMappingSignal(TXmlEndPrefixMappingSignal(Signal), XmlErrorType, Flaw);
      end else

      if Signal is TXmlCompletedSignal then begin
        case FRootProcessingStatus of
          rsBeforeRoot: begin
            XmlErrorType := ET_ROOT_ELEMENT_NOT_FOUND;
            Flaw := '';
          end;
          rsInRoot: begin
            XmlErrorType := ET_MISSING_END_TAG;
            Flaw := '';
            Clue := LastOpenTag;
          end
        else
          FDoctypeFound := False;
          FRootProcessingStatus := rsBeforeRoot;
        end;
        FActivityStatus := asInactive;
      end else

      if Signal is TXmlAbortedSignal then begin
        Reset;
      end else

      if not (ssDoc in Signal.Scope) then
        raise EParserException.Create('Internal Parser Exception');
    end;

    asDocFragActive: begin

      if Signal is TXmlDoctypeSignal then begin
        CheckDoctypeSignal(TXmlDoctypeSignal(Signal), XmlErrorType, Flaw);
      end else

      if Signal is TXmlEndElementSignal then begin
        CheckEndElementSignal(TXmlEndElementSignal(Signal), XmlErrorType, Flaw);
      end else

      if Signal is TXmlStartElementSignal then begin
        FRootProcessingStatus := rsInRoot;
        FTagStack.Add(TXmlStartElementSignal(Signal).TagName);
      end else

      if Signal is TXmlStartPrefixMappingSignal then begin
        FPrefixStack.Add(TXmlStartPrefixMappingSignal(Signal).Prefix);
      end else

      if Signal is TXmlEndPrefixMappingSignal then begin
        CheckEndPrefixMappingSignal(TXmlEndPrefixMappingSignal(Signal), XmlErrorType, Flaw);
      end else

      if Signal is TXmlCompletedSignal then begin
        if FRootProcessingStatus = rsInRoot then begin
          XmlErrorType := ET_MISSING_END_TAG;
          Flaw := '';
          Clue := LastOpenTag;
        end else begin
          FDoctypeFound := False;
          FRootProcessingStatus := rsBeforeRoot;
        end;
        FActivityStatus := asInactive;
      end else

      if Signal is TXmlAbortedSignal then begin
        Reset;
      end else

      if not (ssDoc in Signal.Scope) then
        raise EParserException.Create('Internal Parser Exception');
    end;

    asExtDtdActive, asIntDtdActive: begin

      if not (ssDtd in Signal.Scope) then
        raise EParserException.Create('Internal Parser Exception');

      if Signal is TXmlCompletedSignal then
        FActivityStatus := asInactive;

    end;

    asInactive: begin

      if (Signal is TXmlStartDocumentSignal) then begin
        FActivityStatus := asDocActive;
        FPrefixStack.Clear;
        FTagStack.Clear;
        FDoctypeFound := False;
        FRootProcessingStatus := rsBeforeRoot;
      end else

      if (Signal is TXmlStartDocumentFragmentSignal) then begin
        FActivityStatus := asDocFragActive;
        FPrefixStack.Clear;
        FTagStack.Clear;
        FDoctypeFound := False;
        FRootProcessingStatus := rsBeforeRoot;
      end else

      if Signal is TXmlStartExtDtdSignal then begin
        FActivityStatus := asExtDtdActive;
      end else

      if Signal is TXmlStartIntDtdSignal then begin
        FActivityStatus := asIntDtdActive;
      end else

      if Signal is TXmlAbortedSignal then begin
        Reset;
      end else

        raise EParserException.Create('Internal Parser Exception');
    end;

  end; {case ...}

  if XmlErrorType = ET_NONE then
    Signal.CheckWellformedness(XmlErrorType, Flaw, Clue);

  if XmlErrorType = ET_NONE then begin
    if Assigned(NextHandler) then
      NextHandler.ProcessSignal(Signal);
  end else
    SendErrorNotification(Signal.Reader, XmlErrorType, Signal, Flaw, Clue);
end;

procedure TXmlWFTestHandler.Notification(AComponent: TComponent;
                                         Operation: TOperation);
begin
  inherited notification(AComponent,Operation);
  if (Operation = opRemove) and (AComponent = FNextHandler)
    then FNextHandler := nil;
end;

procedure TXmlWFTestHandler.Reset;
begin
  FActivityStatus := asInactive;
  FDoctypeFound := False;
  FRootProcessingStatus := rsBeforeRoot;
  FPrefixStack.Clear;
  FTagStack.Clear;
end;



// +++++++++++++++++++++ TXmlNamespaceSignalGenerator +++++++++++++++++++++
constructor TXmlNamespaceSignalGenerator.Create(AOwner: TComponent);
begin
  inherited;
  FPrefixMapping := True;
  FSuppressXmlns := False;

  FStartElementIsOpen := False;

  FAttributeSignals := TObjectList.Create;
  FAttributeSignals.OwnsObjects := True;

  FPrefixMappingStack := TList.Create;
end;

destructor TXmlNamespaceSignalGenerator.Destroy;
begin
  ClearPrefixMappingStack;
  FPrefixMappingStack.Free;
  FAttributeSignals.Free;
  inherited;
end;

procedure TXmlNamespaceSignalGenerator.ClearPrefixMappingStack;
begin
  with FPrefixMappingStack do begin
    while Count > 0 do begin
      TUtilsWideStringList(Last).Free;
      Delete(Pred(Count));
    end;
  end;
end;

procedure TXmlNamespaceSignalGenerator.CloseStartElement(const Sender: TXmlCustomReader;
                                                         const Locator: IDomLocator);
var
  XmlAttributeSignal: TXmlAttributeSignal;
  XmlStartElementSignal: TXmlStartElementSignal;
begin
  if FStartElementIsOpen then begin

    if Assigned(NextHandler) then begin

      XmlStartElementSignal := TXmlStartElementSignal.CreateFromLocator(Sender, Locator);
      try
        XmlStartElementSignal.TagName := FElementName;
        NextHandler.ProcessSignal(XmlStartElementSignal);
      finally
        XmlStartElementSignal.Free;
      end;

      with FAttributeSignals do
        while Count > 0 do begin
          XmlAttributeSignal := TXmlAttributeSignal(Extract(First));
            // Remark:
            //   The TObjectList.Extract function returns a pointer in Delphi 5
            //   and 6 (but a TObject in Delphi 7+).  Therefore, we must not
            //   write here
            //     XmlAttributeSignal := Extract(First) as TXmlAttributeSignal;
            //   because Delphi 5 and 6 would complain with an "Operator not
            //   applicable to this operant type" error.
          try
            NextHandler.ProcessSignal(XmlAttributeSignal);
          finally
            XmlAttributeSignal.Free;
          end;
        end;

    end; {if ...}

    FStartElementIsOpen := False;
  end;
end;

procedure TXmlNamespaceSignalGenerator.ProcessAttributeSignal(const Signal: TXmlAttributeSignal);
var
  Len: Integer;
  NamespacePrefix: WideString;
  PfxUriList: TUtilsWideStringList;
begin
  if not FStartElementIsOpen then
    raise EParserException.Create('Internal Parser Exception');

  if StartsWideStr(WideString('xmlns'), Signal.Name) then begin
    if FPrefixMapping then begin 
      PfxUriList := FPrefixMappingStack.Last;
      if not Assigned(PfxUriList) then
        raise EParserException.Create('Internal Parser Exception');

      Len := Length(Signal.Name);
      if Len > 6 then begin
        // Attribute name has the form 'xmlns:...':
        NamespacePrefix := Copy(Signal.Name, 7, Len);
        PfxUriList.Add(NamespacePrefix);
        WriteStartPrefixMapping(Signal.Reader, Signal, NamespacePrefix, Signal.Value);
      end else begin
        // Attribute name has the form 'xmlns':
        PfxUriList.Add('');
        WriteStartPrefixMapping(Signal.Reader, Signal, '', Signal.Value);
      end;
    end;
    if not FSuppressXmlns then
      FAttributeSignals.Add(Signal.CloneSignal(Signal.Reader)); // Store a copy of the signal.
  end else
    FAttributeSignals.Add(Signal.CloneSignal(Signal.Reader));   // Store a copy of the signal.
end;

procedure TXmlNamespaceSignalGenerator.ProcessSignal(const Signal: TXmlSignal);
begin
  if Signal is TXmlAttributeSignal then begin
    ProcessAttributeSignal(Signal as TXmlAttributeSignal);
  end else begin

    if Signal is TXmlAbortedSignal then begin
      Reset;
      if Assigned(NextHandler) then
        NextHandler.ProcessSignal(Signal);
    end else begin

      CloseStartElement(Signal.Reader, Signal);

      if Signal is TXmlStartElementSignal then begin
        ProcessStartElementSignal(Signal as TXmlStartElementSignal);
      end else

      if (Signal is TXmlEndElementSignal) then begin
        if Assigned(NextHandler) then
          NextHandler.ProcessSignal(Signal);
        WriteEndPrefixMapping(Signal.Reader, Signal);

      end else begin

        if (Signal is TXmlCompletedSignal) or
           (Signal is TXmlStartDocumentSignal) or
           (Signal is TXmlStartDocumentFragmentSignal) then
          Reset;

        if Assigned(NextHandler) then
          NextHandler.ProcessSignal(Signal);

      end;

    end; {if ... else ...}

  end; {if ... else ...}
end;

procedure TXmlNamespaceSignalGenerator.ProcessStartElementSignal(const Signal: TXmlStartElementSignal);
begin
  if FStartElementIsOpen then
    raise EParserException.Create('Internal Parser Exception');

  FElementName := Signal.TagName;
  FAttributeSignals.Clear;
  FStartElementIsOpen := True;

  if FPrefixMapping then
    FPrefixMappingStack.Add(TUtilsWideStringList.Create);
end;

procedure TXmlNamespaceSignalGenerator.Reset;
begin
  ClearPrefixMappingStack;
  FAttributeSignals.Clear;
  FStartElementIsOpen := False;
end;

procedure TXmlNamespaceSignalGenerator.WriteEndPrefixMapping(const Sender: TXmlCustomReader;
                                                             const Locator: IDomLocator);
var
  XmlEndPrefixMappingSignal: TXmlEndPrefixMappingSignal;
  PfxUriList: TUtilsWideStringList;
  I: Integer;
begin
  if FPrefixMapping then
    with FPrefixMappingStack do
      if Count > 0 then begin
        PfxUriList := Last;
        Delete(Pred(Count));
        try
          if Assigned(NextHandler) then
            with PfxUriList do
              for I := Pred(Count) downto 0 do begin
                XmlEndPrefixMappingSignal := TXmlEndPrefixMappingSignal.CreateFromLocator(Sender, Locator);
                try
                  XmlEndPrefixMappingSignal.Prefix := WideStrings[I];
                  NextHandler.ProcessSignal(XmlEndPrefixMappingSignal);
                finally
                  XmlEndPrefixMappingSignal.Free;
                end;
              end;
        finally
          PfxUriList.Free;
        end;
      end; {if ...}
end;

procedure TXmlNamespaceSignalGenerator.WriteStartPrefixMapping(const Sender: TXmlCustomReader;
                                                               const Locator: IDomLocator;
                                                               const Prefix,
                                                                     Uri: WideString);
var
  XmlStartPrefixMappingSignal: TXmlStartPrefixMappingSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartPrefixMappingSignal := TXmlStartPrefixMappingSignal.CreateFromLocator(Sender, Locator);
    try
      XmlStartPrefixMappingSignal.Prefix := Prefix;
      XmlStartPrefixMappingSignal.Uri := Uri;
      NextHandler.ProcessSignal(XmlStartPrefixMappingSignal);
    finally
      XmlStartPrefixMappingSignal.Free;
    end;
  end;
end;



// ++++++++++++++++++++++++++++ TXmlDomBuilder ++++++++++++++++++++++++++++
constructor TXmlDomBuilder.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRefNode := nil;
  FBuildIDList := True;
  FDocTypeDeclTreatment := dtCheckWellformedness;
  FKeepCDATASections := True;
  FKeepComments := True;
  FKeepEntityRefs := True;
  FPrefixUriList := TUtilsNameValueList.Create;
end;

destructor TXmlDomBuilder.Destroy;
begin
  FPrefixUriList.Free;
  inherited Destroy;
end;

procedure TXmlDomBuilder.ProcessSignal(const Signal: TXmlSignal);
var
  I: Integer;
  Prfx, LocalName, AttrNsUri: WideString;
  ElementNsUri: WideString; // = ''
  NewCData: TDomCDATASection;
  NewComment: TDomComment;
  NewDocType: TDomDocumentTypeDecl;
  NewElement: TDomElement;
  NewEntityRef: TDomEntityReference;
  NewPI: TDomProcessingInstruction;
begin
  if Signal is TXmlAttributeSignal then begin
    if Assigned(FRefNode) then begin
      if FRefNode.RootDocument is TDomDocumentNS then begin // Build namespace tree?

        // Compute namespace attribute:
        if TXmlAttributeSignal(Signal).Name = 'xmlns' then begin
          (FRefNode as TDomElement).SetAttributeNS('http://www.w3.org/2000/xmlns/',
                                                   'xmlns',
                                                   TXmlAttributeSignal(Signal).Value);
        end else begin
          XmlExtractPrefixAndLocalName(TXmlAttributeSignal(Signal).Name, Prfx, LocalName);
          if Prfx = '' then begin
            AttrNsUri := '';
          end else if Prfx = 'xml' then begin
            AttrNsUri := 'http://www.w3.org/XML/1998/namespace';
          end else if Prfx = 'xmlns' then begin
            AttrNsUri := 'http://www.w3.org/2000/xmlns/';
          end else begin
            I := FPrefixUriList.IndexOfLastName(Prfx);
            if I > -1 then
              AttrNsUri := FPrefixUriList.Values[I];
          end;
          (FRefNode as TDomElement).SetAttributeNS(AttrNsUri,
                                                   TXmlAttributeSignal(Signal).Name,
                                                   TXmlAttributeSignal(Signal).Value);
        end; {if ... else ...}

        // Update IDs:
        if BuildIDList then
          if TXmlAttributeSignal(Signal).DataType = AS_ID_DATATYPE then
            (FRefNode.RootDocument as TDomDocumentNS).IDs.AddObject(
              TXmlAttributeSignal(Signal).Value, FRefNode); 

      end else begin

        (FRefNode as TDomElement).SetAttribute(TXmlAttributeSignal(Signal).Name,
                                               TXmlAttributeSignal(Signal).Value);

      end; {if ... else ...}
    end; {if Assigned(FRefNode) ...}
  end else

  if Signal is TXmlCDATASignal then begin
    if Assigned(FRefNode) then begin
      if FKeepCDATASections then begin
        NewCData := TDomCDATASection.Create(FRefNode.RootDocument);
        try
          NewCData.Data:= TXmlCDATASignal(Signal).Data;
          FRefNode.AppendChild(NewCData);
        except
          NewCData.Free;
          raise;
        end; {try ...}
      end else
        ProcessPCDATA(Signal.Reader, Signal, TXmlCDATASignal(Signal).Data, False);
    end; {if Assigned(FRefNode) ...}
  end else


  if Signal is TXmlCommentSignal then begin
    if FKeepComments then begin
      if Assigned(FRefNode) then begin
        NewComment := TDomComment.Create(FRefNode.RootDocument);
        try
          NewComment.Data:= TXmlCommentSignal(Signal).Data;
          FRefNode.AppendChild(NewComment);
        except
          NewComment.Free;
          raise;
        end; {try ...}
      end; {if Assigned(FRefNode) ...}
    end; {if FKeepComments ...}
  end else


  if Signal is TXmlDoctypeSignal then begin
    if Assigned(FRefNode) then begin
      if DocTypeDeclTreatment <> dtIgnore then begin
         NewDocType := TDomDocumentTypeDecl.Create(
                        FRefNode.RootDocument,
                        TXmlDoctypeSignal(Signal).DoctypeName,
                        TXmlDoctypeSignal(Signal).PublicId,
                        TXmlDoctypeSignal(Signal).SystemId,
                        TXmlDoctypeSignal(Signal).Data);
        try
          with NewDocType do begin
            IntSubsetStartByteNumber := TXmlDoctypeSignal(Signal).IntSubsetStartByteNumber;
            IntSubsetStartCharNumber := TXmlDoctypeSignal(Signal).IntSubsetStartCharNumber;
            IntSubsetStartColumn := TXmlDoctypeSignal(Signal).IntSubsetStartColumn;
            IntSubsetStartLine := TXmlDoctypeSignal(Signal).IntSubsetStartLine;
          end;
          FRefNode.AppendChild(NewDocType);
          if FRefNode is TDomDocument then
            case DocTypeDeclTreatment of
              dtCheckWellformedness: begin
                (FRefNode as TDomDocument).ValidationAgent.BuildDtdModel(False);
                if (FRefNode as TDomDocument).ValidationAgent.DtdModel.PreparationStatus = PS_INCOMPLETE_ABORTED then
                  raise EParserException.Create('Non-wellformed DTD.');
              end;
              dtCheckValidity: begin
                (FRefNode as TDomDocument).ValidationAgent.BuildDtdModel(True);
                if (FRefNode as TDomDocument).ValidationAgent.DtdModel.PreparationStatus = PS_INCOMPLETE_ABORTED then
                  raise EParserException.Create('Non-wellformed or invalid DTD.');
              end;
            end;
        except
          NewDocType.Free;
          raise;
        end; {try ...}
      end; {if ...}
    end; {if Assigned(FRefNode) ...}
  end else


  if Signal is TXmlEndElementSignal then begin
    if Assigned(FRefNode) then
      FRefNode:= FRefNode.ParentNode;
  end else


  if Signal is TXmlEndPrefixMappingSignal then begin
    with FPrefixUriList do
      Delete(Pred(Length));
  end else


  if Signal is TXmlEntityRefSignal then begin
    if Assigned(FRefNode) then begin
      if KeepEntityRefs or not IsXmlPredefinedEntityName(TXmlEntityRefSignal(Signal).EntityName) then begin
        NewEntityRef := TDomEntityReference.Create(
                          FRefNode.RootDocument,
                          TXmlEntityRefSignal(Signal).EntityName);
        try
          FRefNode.AppendChild(NewEntityRef);
        except
          NewEntityRef.Free;
          raise;
        end; {try ...}
      end else begin
        if TXmlEntityRefSignal(Signal).EntityName = 'lt' then begin
          ProcessPCDATA(Signal.Reader,Signal, #60, False);
        end else if TXmlEntityRefSignal(Signal).EntityName = 'gt' then begin
          ProcessPCDATA(Signal.Reader,Signal, #62, False);
        end else if TXmlEntityRefSignal(Signal).EntityName = 'amp' then begin
          ProcessPCDATA(Signal.Reader,Signal, #38, False);
        end else if TXmlEntityRefSignal(Signal).EntityName = 'apos' then begin
          ProcessPCDATA(Signal.Reader,Signal, #39, False);
        end else if TXmlEntityRefSignal(Signal).EntityName = 'quot' then begin
          ProcessPCDATA(Signal.Reader,Signal, #34, False);
        end;
      end; {if ... else}
    end; {if Assigned(FRefNode) ...}
  end else


  if Signal is TXmlPCDATASignal then begin
    if Assigned(FRefNode) then
      if FRefNode.NodeType <> ntDocument_Node then
        ProcessPCDATA(Signal.Reader, Signal, TXmlPCDATASignal(Signal).Data,
                      TXmlPCDATASignal(Signal).CharRefGenerated);
  end else


  if Signal is TXmlProcessingInstructionSignal then begin
    if Assigned(FRefNode) then begin
      NewPI := TDomProcessingInstruction.Create(
                 FRefNode.RootDocument,
                 TXmlProcessingInstructionSignal(Signal).Target);
      try
        NewPI.Data:= TXmlProcessingInstructionSignal(Signal).Data;
        FRefNode.AppendChild(NewPI);
      except
        NewPI.Free;
        raise;
      end;
    end; {if Assigned(FRefNode) ...}
  end else


  if Signal is TXmlSkippedEntitySignal then begin
    // notifications through skippedEntity() are being ignored.
  end else


  if Signal is TXmlStartDocumentSignal then begin
    FPrefixUriList.Clear;

    if Assigned(FRefNode) then begin
      if (FRefNode.NodeType = ntDocument_Node) then begin
        with (FRefNode as TDomCustomDocument) do begin
          InputEncoding := TXmlStartDocumentSignal(Signal).InputEncoding;
          XmlEncoding := TXmlStartDocumentSignal(Signal).EncodingName;
          XmlStandalone := TXmlStartDocumentSignal(Signal).StandaloneDecl;
          XmlVersion := TXmlStartDocumentSignal(Signal).Version;
          DocumentUri := Signal.Uri
        end;
      end;
      if FRefNode is TDomDocumentNS then
        (FRefNode as TDomDocumentNS).IDs.Clear;
    end;
  end else


  if Signal is TXmlStartDocumentFragmentSignal then begin
    FPrefixUriList.Clear;
  end else


  if Signal is TXmlStartElementSignal then begin
    if Assigned(FRefNode) then begin

      if FRefNode.RootDocument is TDomDocumentNS then begin // Build namespace tree?

        // Parse into namespace-aware document tree:

        XmlExtractPrefixAndLocalName(TXmlStartElementSignal(Signal).TagName, Prfx, LocalName);
        with FPrefixUriList do begin
          I := IndexOfLastName(Prfx);
          if I > -1 then
            ElementNsUri := Values[I];
        end; {with ...}

        NewElement := TDomElement.CreateNS(FRefNode.RootDocument as TDomDocumentNS,
                        ElementNsUri, TXmlStartElementSignal(Signal).TagName);
        FRefNode.AppendChild(NewElement);
        FRefNode := NewElement;

      end else begin

        // Parse into non-namespace-aware document tree:

        NewElement := TDomElement.Create(FRefNode.RootDocument as TDomDocument,
                        TXmlStartElementSignal(Signal).TagName);
        FRefNode.AppendChild(NewElement);
        FRefNode := NewElement;

      end;

    end; {if Assigned(FRefNode) ...}
  end else


  if Signal is TXmlStartPrefixMappingSignal then begin
    FPrefixUriList.Add(TXmlStartPrefixMappingSignal(Signal).Prefix,
                       TXmlStartPrefixMappingSignal(Signal).Uri);
  end else


  if Signal is TXmlAbortedSignal then begin
    Reset;
  end else

  if not (ssDoc in Signal.Scope) then
    raise EParserException.Create('Internal Parser Exception');

end;

procedure TXmlDomBuilder.Reset;
begin
  FPrefixUriList.Clear;
end;

procedure TXmlDomBuilder.ProcessPCDATA(const Sender: TXmlCustomReader;
                                       const Locator: IDomLocator;
                                       const Data: WideString;
                                       const CharRefGenerated: Boolean);
var
  NewPcdata: TDomText;
begin
  if Assigned(FRefNode.LastChild) and (FRefNode.LastChild.NodeType = ntText_Node) then begin
    (FRefNode.LastChild as TDomText).AppendData(Data);
    if CharRefGenerated then
      (FRefNode.LastChild as TDomText).CharRefGenerated := True;
  end else begin
    NewPcdata := TDomText.Create(FRefNode.RootDocument);
    try
      NewPcdata.Data := Data;
      NewPcdata.CharRefGenerated := CharRefGenerated;
      FRefNode.AppendChild(NewPcdata);
    except
      NewPcdata.Free;
      raise;
    end;
  end;
end;



// +++++++++++++++++++++++++++ TXmlDtdModelBuilder ++++++++++++++++++++++++++++
constructor TXmlDtdModelBuilder.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActivityStatus := asInactive;
  FDocStandalone := STANDALONE_UNSPECIFIED;
  FIgnoreDeclarations := False;
  FDtdModel := nil;
end;

procedure TXmlDtdModelBuilder.InsertMixedContent(const RefASElementDecl: TDtdElementDecl;
                                                 const ContSpec: WideString);
var
  Dummy, Content, Piece: WideString;
  Freq: TDtdFrequency;
  Separator: Integer;
  Error: Boolean;
  NewASContentModel: TDtdContentModel;
begin
  Content := TrimWhitespace(ContSpec);
  Freq := DTD_REQUIRED_FRQ;
  if (Content[Length(Content)] = '*') then begin
    Freq := DTD_ZERO_OR_MORE_FRQ;
    Dummy := Copy(Content, 1, Length(Content) - 1);
    Content := Dummy;
  end;
  if Length(Content) = 0 then
    raise EParserException.Create('Parser error.');
  if WideChar(Content[Length(Content)]) <> ')' then
    raise EParserException.Create('Parser error.');
  XMLTruncRoundBrackets(Content, Dummy, Error);
  if Error or (Dummy = '') then
    raise EParserException.Create('Parser error.');
  Content := Dummy;
  NewASContentModel := RefASElementDecl.CreateContentModel('', DTD_CHOICE_CM);
  NewASContentModel.Frequency := Freq;
  RefASElementDecl.ReplaceContentModel(NewASContentModel);
  if Content = '#PCDATA' then begin
    if (Freq <> DTD_REQUIRED_FRQ) and (Freq <> DTD_ZERO_OR_MORE_FRQ) then
      raise EParserException.Create('Parser error.');
    Exit;
  end;
  if Freq <> DTD_ZERO_OR_MORE_FRQ then
    raise EParserException.Create('Parser error.');
  Separator := Pos(WideString('|'), Content);
  if Separator = 0 then
    raise EParserException.Create('Parser error.');
  Dummy := TrimWhitespace(Copy(Content, Separator + 1, Length(Content) - Separator));
  Content := Dummy;
  while Content <> '' do begin
    Separator := Pos(WideString('|'), Content);
    if Separator = 0 then begin
      Piece := Content;
      Content := '';
    end else begin
      Piece := TrimWhitespace(Copy(Content, 1, Separator - 1));
      Dummy := TrimWhitespace(Copy(Content, Separator + 1, Length(Content) - Separator));
      Content := Dummy;
      if Content = '' then
        raise EParserException.Create('Parser error.');
    end; {if ...}
    if not IsXmlName(Piece) then
      raise EParserException.Create('Parser error.');
    NewASContentModel.SubModels.AppendNode(RefASElementDecl.CreateContentModel(Piece, DTD_ELEMENT_CM));
  end; {while ...}
end;

procedure TXmlDtdModelBuilder.InsertChildrenContent(const RefDtdObject: TDtdObject;
                                                    const ContSpec: WideString);
var
  Piece, Dummy, Content: WideString;
  SeparatorChar: WideChar;
  Freq: TDtdFrequency;
  J, I, BracketNr: Integer;
  NewASContentModel_1, NewASContentModel_2: TDtdContentModel;
  Error: Boolean;
begin
  Content := TrimWhitespace(ContSpec);
  if Content[Length(Content)] = WideChar('?') then begin
    Freq := DTD_OPTIONAL_FRQ;
    Dummy := Copy(Content, 1, Length(Content) - 1);
    Content := Dummy;
  end else if Content[Length(Content)] = WideChar('*') then begin
    Freq := DTD_ZERO_OR_MORE_FRQ;
    Dummy := Copy(Content, 1, Length(Content) - 1);
    Content := Dummy;
  end else if Content[Length(Content)] = WideChar('+') then begin
    Freq := DTD_ONE_OR_MORE_FRQ;
    Dummy := Copy(Content, 1, Length(Content) - 1);
    Content := Dummy;
  end else Freq := DTD_REQUIRED_FRQ;
  if Length(Content) = 0 then
    raise EParserException.Create('Parser error.');
  if WideChar(Content[Length(Content)]) <> ')' then
    raise EParserException.Create('Parser error.');
  XMLTruncRoundBrackets(Content, Dummy, Error);
  if Error or (Dummy = '') then
    raise EParserException.Create('Parser error.');
  Content := Dummy;

  BracketNr := 0;
  SeparatorChar := ',';
  for I := 1 to Length(Content) do begin
    if (Content[I] = ',') and (BracketNr = 0) then begin
      SeparatorChar := ',';
      Break;
    end; {if ...}
    if (Content[I] = '|') and (BracketNr = 0) then begin
      SeparatorChar := '|';
      Break;
    end; {if ...}
    if Content[I] = '(' then Inc(BracketNr);
    if Content[I] = ')' then begin
      if BracketNr = 0 then raise EParserException.Create('Parser error.');
      Dec(BracketNr);
    end;
  end; {for ...}

  if SeparatorChar = ',' then begin
    case RefDtdObject.ObjectType of
      DTD_CONTENT_MODEL:
      begin
        NewASContentModel_1 := (RefDtdObject as TDtdContentModel).OwnerElementDecl.CreateContentModel('', DTD_SEQUENCE_CM);
        NewASContentModel_1.Frequency := Freq;
        (RefDtdObject as TDtdContentModel).SubModels.AppendNode(NewASContentModel_1);
      end;
      DTD_ELEMENT_DECLARATION:
      begin
        NewASContentModel_1 := (RefDtdObject as TDtdElementDecl).CreateContentModel('', DTD_SEQUENCE_CM);
        NewASContentModel_1.Frequency := Freq;
        (RefDtdObject as TDtdElementDecl).ReplaceContentModel(NewASContentModel_1);
      end;
    else
      raise EParserException.Create('Parser error.');
    end;
  end else begin
    case RefDtdObject.ObjectType of
      DTD_CONTENT_MODEL:
      begin
        NewASContentModel_1 := (RefDtdObject as TDtdContentModel).OwnerElementDecl.CreateContentModel('', DTD_CHOICE_CM);
        NewASContentModel_1.Frequency := Freq;
        (RefDtdObject as TDtdContentModel).SubModels.AppendNode(NewASContentModel_1);
      end;
      DTD_ELEMENT_DECLARATION:
      begin
        NewASContentModel_1 := (RefDtdObject as TDtdElementDecl).CreateContentModel('', DTD_CHOICE_CM);
        NewASContentModel_1.Frequency := Freq;
        (RefDtdObject as TDtdElementDecl).ReplaceContentModel(NewASContentModel_1);
      end;
    else
      raise EParserException.Create('Parser error.');
    end;
  end;

  BracketNr := 0;
  I := 0;
  J := 1;
  while I < Length(Content) do begin
    Inc(I);
    if Content[I] = '(' then Inc(BracketNr);
    if Content[I] = ')' then begin
      if BracketNr = 0 then raise EParserException.Create('Parser error.');
      Dec(BracketNr);
    end;
    if ((Content[I] = SeparatorChar) and (BracketNr = 0)) or
       (I = Length(Content)) then begin
      if BracketNr > 0 then raise EParserException.Create('Parser error.');
      if I = Length(Content)
        then Piece := TrimWhitespace(Copy(Content, J, I + 1 - J))
        else Piece := TrimWhitespace(Copy(Content, J, I - J));
      J := I + 1;

      if Piece[1] = '(' then begin
        InsertChildrenContent(NewASContentModel_1, Piece);
      end else begin
        if Piece[Length(Piece)] = WideChar('?') then begin
          Freq := DTD_OPTIONAL_FRQ;
          Dummy := Copy(Piece, 1, Length(Piece) - 1);
          Piece := Dummy;
        end else if Piece[Length(Piece)] = WideChar('*') then begin
          Freq := DTD_ZERO_OR_MORE_FRQ;
          Dummy := Copy(Piece, 1, Length(Piece) - 1);
          Piece := Dummy;
        end else if Piece[Length(Piece)] = WideChar('+') then begin
          Freq := DTD_ONE_OR_MORE_FRQ;
          Dummy := Copy(Piece, 1, Length(Piece) - 1);
          Piece := Dummy;
        end else Freq := DTD_REQUIRED_FRQ;
        if not IsXmlName(Piece)
          then raise EParserException.Create('Parser error.');
        NewASContentModel_2 := NewASContentModel_1.OwnerElementDecl.CreateContentModel(Piece, DTD_ELEMENT_CM);
        NewASContentModel_2.Frequency := Freq;
        NewASContentModel_1.SubModels.AppendNode(NewASContentModel_2);
      end; {if ...}

    end; {if ...}
  end; {while ...}

end;

procedure TXmlDtdModelBuilder.ProcessSignal(const Signal: TXmlSignal);

var
  NewASAttributeDecl: TDtdAttributeDecl;
  NewElementDecl: TDtdElementDecl;
  NewEntityDecl: TDtdEntityDecl;
  NewNotationDecl: TDtdNotationDecl;
  ContentType: TDtdContentType;
  Origin: TDtdOrigin;
  Data2: WideString;
begin
  if not Assigned(DtdModel) then
    Exit;

  if (Signal is TXmlAttributeDefinitionSignal) then begin
    if not FIgnoreDeclarations then
      with TXmlAttributeDefinitionSignal(Signal) do begin
        if (ActivityStatus = asExtDtdActive) or IsDeclaredInPE
          then Origin := DTD_EXTERNALLY_DECLARED
          else Origin := DTD_INTERNALLY_DECLARED;
        if not DtdModel.SetAttributeDecl(ElementName, AttributeName,
                          DefaultValue, Enumeration, AttributeType,
                          Constraint, Origin, NewASAttributeDecl) then
          SendErrorNotification(Signal.Reader, ET_DOUBLE_ATTDEF, Signal,
            TXmlAttributeDefinitionSignal(Signal).AttributeName, '');
      end;
  end else

  if (Signal is TXmlElementTypeDeclarationSignal) then begin
    if not FIgnoreDeclarations then

      Data2 := TrimWhitespace(TXmlElementTypeDeclarationSignal(Signal).Data);

      if Data2 = 'EMPTY' then begin
        ContentType := DTD_EMPTY_CONTENTTYPE;
        Data2 := '';
      end else if Data2 = 'ANY' then begin
        ContentType := DTD_ANY_CONTENTTYPE;
        Data2 := '';
      end else if Pos('#PCDATA', Data2) > 0 then
        ContentType := DTD_MIXED_CONTENTTYPE
      else
        ContentType := DTD_ELEMENT_CONTENTTYPE;

      if (ActivityStatus = asExtDtdActive) or TXmlElementTypeDeclarationSignal(Signal).IsDeclaredInPE
        then Origin := DTD_EXTERNALLY_DECLARED
        else Origin := DTD_INTERNALLY_DECLARED;

      try
        if DtdModel.SetElementDecl(TXmlElementTypeDeclarationSignal(Signal).ElementName,
                                     ContentType, Origin, NewElementDecl)
        then begin
          case ContentType of
            DTD_MIXED_CONTENTTYPE: InsertMixedContent(NewElementDecl, TXmlElementTypeDeclarationSignal(Signal).Data);
            DTD_ELEMENT_CONTENTTYPE: InsertChildrenContent(NewElementDecl, TXmlElementTypeDeclarationSignal(Signal).Data);
          end;
        end else
          // VC: Unique Element Type Declaration (XML 1.0, § 3.2)
          SendErrorNotification(Signal.Reader, ET_DUPLICATE_ELEMENT_TYPE_DECL, Signal,
            TXmlElementTypeDeclarationSignal(Signal).ElementName, '');
      except
        SendErrorNotification(Signal.Reader, ET_INVALID_ELEMENT_DECL, Signal,
          TXmlElementTypeDeclarationSignal(Signal).ElementName, '');
      end; {try ...}

  end else

  if Signal is TXmlEntityDeclarationSignal then begin
    if not FIgnoreDeclarations then begin
      if (ActivityStatus = asExtDtdActive) or TXmlEntityDeclarationSignal(Signal).IsDeclaredInPE
        then Origin := DTD_EXTERNALLY_DECLARED
        else Origin := DTD_INTERNALLY_DECLARED;

      if DtdModel.SetEntityDecl(TXmlEntityDeclarationSignal(Signal).EntityName,
                                ResolveCharRefs(TXmlEntityDeclarationSignal(Signal).EntityValue),  // [*]   {TODO 4 -cRevisit : Change character reference resolvement?  What about exceptions?}
                                TXmlEntityDeclarationSignal(Signal).PublicId,
                                TXmlEntityDeclarationSignal(Signal).SystemId,
                                TXmlEntityDeclarationSignal(Signal).NotationName,
                                TXmlEntityDeclarationSignal(Signal).BaseUri,
                                Origin,
                                NewEntityDecl) then begin
            // [*] Note that the TXmlEntityDeclarationSignal.EntityValue property
            //     contains a semi-processed entity value: Paremeter entity
            //     references, which may appear in entity declarations in the
            //     external subset of a DTD, have already been replaced.  What
            //     needs to be done in order to construct the replacement text
            //     of an internal entity is to replace the character references
            //     (cf. [XML 1.0], sec. 4.5).
        if not NewEntityDecl.CheckNoRecursion then
          SendErrorNotification(Signal.Reader, ET_RECURSIVE_REFERENCE, Signal,
            TXmlEntityDeclarationSignal(Signal).EntityName, '');
      end else
        SendErrorNotification(Signal.Reader, ET_DOUBLE_ENTITY_DECL, Signal,
          TXmlEntityDeclarationSignal(Signal).EntityName, '');
    end;
  end else

  if Signal is TXmlNotationDeclarationSignal then begin
    if not FIgnoreDeclarations then begin
      if (ActivityStatus = asExtDtdActive) or TXmlNotationDeclarationSignal(Signal).IsDeclaredInPE
        then Origin := DTD_EXTERNALLY_DECLARED
        else Origin := DTD_INTERNALLY_DECLARED;
      if not DtdModel.SetNotationDecl(TXmlNotationDeclarationSignal(Signal).NotationName,
                                      TXmlNotationDeclarationSignal(Signal).PublicId,
                                      TXmlNotationDeclarationSignal(Signal).SystemId,
                                      Origin,
                                      NewNotationDecl) then
        SendErrorNotification(Signal.Reader, ET_DUPLICATE_NOTATION_DECL, Signal,
          TXmlNotationDeclarationSignal(Signal).NotationName, '');
    end;
  end else

  if Signal is TXmlPEReferenceFoundSignal then begin
    if FActivityStatus = asIntDtdActive then
      DtdModel.PEsInIntSubset := True;
  end else

  if Signal is TXmlExternalPEReferenceSignal then begin
    if FActivityStatus = asIntDtdActive then begin
      if FDocStandalone in [ STANDALONE_NO, STANDALONE_UNSPECIFIED ] then begin
        FIgnoreDeclarations := True; 
        DtdModel.PreparationStatus := PS_INCOMPLETE_NOT_STANDALONE;
      end else
        DtdModel.PreparationStatus := PS_INCOMPLETE_STANDALONE;
    end else
      raise EParserException.Create('Internal Parser Exception');
  end else

  if Signal is TXmlStartExtDtdSignal then begin
    if DtdModel.PreparationStatus in [ PS_UNPREPARED, PS_INT_SUBSET_COMPLETED, PS_COMPLETED, PS_INEXISTANT ] then
      DtdModel.PreparationStatus := PS_INCOMPLETE;
    DtdModel.ExtSubsetSysId := TXmlStartExtDtdSignal(Signal).SystemId;
    FActivityStatus := asExtDtdActive;
  end else

  if Signal is TXmlStartIntDtdSignal then begin
    DtdModel.PreparationStatus := PS_INCOMPLETE;
    DtdModel.IntSubsetSysId := TXmlStartIntDtdSignal(Signal).SystemId;
    FDocStandalone := TXmlStartIntDtdSignal(Signal).XmlStandalone;
    FActivityStatus := asIntDtdActive;
  end else

  if Signal is TXmlCompletedSignal then begin
    if FActivityStatus = asIntDtdActive then begin
      if DtdModel.PreparationStatus = PS_INCOMPLETE then
        DtdModel.PreparationStatus := PS_INT_SUBSET_COMPLETED;
    end else if FActivityStatus = asExtDtdActive then begin
      if DtdModel.PreparationStatus = PS_INCOMPLETE then
        DtdModel.PreparationStatus := PS_COMPLETED;
    end else
      raise EParserException.Create('Internal Parser Exception');
    FActivityStatus := asInactive;
    FDocStandalone := STANDALONE_UNSPECIFIED;
  end else

  if Signal is TXmlAbortedSignal then begin
    Reset;
  end else

  if not (ssDtd in Signal.Scope) then
    raise EParserException.Create('Internal Parser Exception');
end;

procedure TXmlDtdModelBuilder.Reset;
begin
  FActivityStatus := asInactive;
  FDocStandalone := STANDALONE_UNSPECIFIED;
  FIgnoreDeclarations := False;
end;

procedure TXmlDtdModelBuilder.SetDtdModel(const Value: TDtdModel);
begin
  FDtdModel := Value;
end;



// ++++++++++++++++++++++++ TXmlStreamBuilder ++++++++++++++++++++++++++
constructor TXmlStreamBuilder.Create(AOwner: TComponent);
begin
  inherited;
  FIncludeXmlDecl := True;
  FCurrentEncoding := '';
  FDefaultEncoding := '';
  FDefaultCodecClass := nil;
  ResetCurrentCodecClass;
  FUseByteOrderMark := [bomUTF16, bomUCS2];
  FOutputSource:= nil;
  FOpenElementsCount:= 0;
  FAttListDeclIsOpen := False;
  FStartElementIsOpen := False;
  FByteCount := 0;
  FCharacterCount := 0;
  FColumnCount := 0;
  FLineFeedCount := 0;
  FTabCount := 0;
end;

procedure TXmlStreamBuilder.DoAfterWrite(const PieceType: TDomPieceType;
                                         const Locator:IDomLocator);
begin
  if Assigned(FOnAfterWrite) then
    FOnAfterWrite(Self, PieceType, Locator);
end;

procedure TXmlStreamBuilder.DoBeforeWrite(const PieceType: TDomPieceType;
                                          const Locator: IDomLocator);
begin
  if Assigned(FOnBeforeWrite) then
    FOnBeforeWrite(Self, PieceType, Locator);
end;

procedure TXmlStreamBuilder.CheckAttListDeclarationClosed(const Sender: TXmlCustomReader;
                                                          const Locator: IDomLocator);
begin
  if FAttListDeclIsOpen then begin
    WriteWideStrings(Sender, Locator, ['>'], False);
    FAttListDeclIsOpen := False;
    DoAfterWrite(xmlAttributeDecl, Locator);
  end;
end;

procedure TXmlStreamBuilder.CheckAttListDeclarationOpen(const Sender: TXmlCustomReader;
                                                        const Locator: IDomLocator;
                                                        const ElementName: WideString);
begin
  if FAttListDeclIsOpen then begin
    if FCurrentAttListDeclName <> ElementName then begin
      WriteWideStrings(Sender, Locator, ['>'], False);
      DoAfterWrite(xmlAttributeDecl, Locator);
      DoBeforeWrite(xmlAttributeDecl, Locator);
      WriteWideStrings(Sender, Locator, [#10'<!ATTLIST ', ElementName, #10], False);
      FCurrentAttListDeclName := ElementName;
    end;
  end else begin
    DoBeforeWrite(xmlAttributeDecl, Locator);
    WriteWideStrings(Sender, Locator, [#10'<!ATTLIST ', ElementName, #10], False);
    FCurrentAttListDeclName := ElementName;
    FAttListDeclIsOpen := True;
  end;
end;

procedure TXmlStreamBuilder.CheckStartElementClosed(const Sender: TXmlCustomReader;
                                                    const Locator: IDomLocator;
                                                    Signal: TXmlSignal);
var
  ShortForm: Boolean;
begin
  if FStartElementIsOpen then begin
    ShortForm := (Signal is TXmlEndElementSignal) and TXmlEndElementSignal(Signal).ShortForm;
    if not ShortForm then
      WriteWideStrings(Sender, Locator, ['>'], False);
    FStartElementIsOpen := False;
    DoAfterWrite(xmlStartTag, Locator);
  end;
end;

function TXmlStreamBuilder.GetCurrentCodecClass: TUnicodeCodecClass;
begin
  if Assigned(FOutputSource)
    then Result := FOutputSource.CodecClass
    else Result := nil;
end;

procedure TXmlStreamBuilder.PutCurrentCodecClass(const Value: TUnicodeCodecClass);
begin
  if Assigned(FOutputSource) then begin
    if Assigned(Value)
      then FOutputSource.CodecClass := Value
      else FOutputSource.CodecClass := TUTF8Codec;
  end;
end;

procedure TXmlStreamBuilder.ResetCurrentCodecClass;
begin
  PutCurrentCodecClass(defaultCodecClass);
end;

procedure TXmlStreamBuilder.SetDefaultEncoding(const Value: WideString);
var
  newCodecClass: TUnicodeCodecClass;
begin
  if Value = '' then begin
    FDefaultEncoding := '';
    FDefaultCodecClass := nil;
  end else begin
    newCodecClass:= StrToEncoding(Value);
    if Assigned(NewCodecClass) then begin
      FDefaultCodecClass := NewCodecClass;
      FDefaultEncoding := Value;
    end else
      raise ENot_Supported_Err.Create('Encoding not supported error.');
  end;
  resetCurrentCodecClass;
end;

procedure TXmlStreamBuilder.SetIncludeXmlDecl(const Value: Boolean);
begin
  FIncludeXmlDecl := Value;
end;

procedure TXmlStreamBuilder.SetOutputSource(const Value: TXmlOutputSource);
begin
  FOutputSource := Value;
  resetCurrentCodecClass;
end;

procedure TXmlStreamBuilder.SetUseByteOrderMark(const Value: TXmlBOMOpt);
begin
  FUseByteOrderMark := Value;
end;

procedure TXmlStreamBuilder.WriteByteOrderMark(const Sender: TXmlCustomReader;
                                               const Locator: IDomLocator;
                                                 out ByteCount: Integer);
const
  UTF_8_BOM    : Array[0..2] of Byte = ($EF, $BB, $BF);
  UTF_16BE_BOM : Array[0..1] of Byte = ($FE, $FF);
  UTF_16LE_BOM : Array[0..1] of Byte = ($FF, $FE);
begin
  ByteCount := 0;
  if not Assigned(FOutputSource) then Exit;
  try
    if (CurrentCodecClass = TUTF16BECodec) then begin
      if (bomUTF16 in UseByteOrderMark) then begin
        ByteCount := 2;
        FOutputSource.Write(UTF_16BE_BOM, 2);
      end;
    end else if CurrentCodecClass = TUTF16LECodec then begin
      if (bomUTF16 in UseByteOrderMark) then begin
        ByteCount := 2;
        FOutputSource.Write(UTF_16LE_BOM, 2);
      end;
    end else if CurrentCodecClass = TUCS2Codec then begin
      if (bomUCS2 in UseByteOrderMark) then begin
        ByteCount := 2;
        FOutputSource.Write(UTF_16BE_BOM, 2);
      end;
    end else if CurrentCodecClass = TUTF8Codec then begin
      if (bomUTF8 in UseByteOrderMark) then begin
        ByteCount := 3;
        FOutputSource.Write(UTF_8_BOM, 3);
      end;
    end;
  except
    raise EParserException.Create('Signal Processing Exception');
  end;
end;

procedure TXmlStreamBuilder.WriteWideString(const S: WideString;
                                            const UseCharRefs: Boolean);
const
  ERROR_STR: string = 'Invalid Character';
var
  CharRef: WideString;
  HighSurrogate, LowSurrogate: WideChar;
  I, J: Integer;
  BytesUsed, BytesUsed_2: Integer;
  UCS4: UCS4Char;
begin
  if not Assigned(FOutputSource) then Exit;
  try
    I := 1;
    while I <= Length(S) do begin
      UCS4 := Ord(S[I]);

      // TestCheck for UTF-16 surrogates and recalculate UCS-4 codepoint if necessary:
      case UCS4 of
      $D800..$DBFF: // High surrogate of Unicode character [$10000..$10FFFF]
        begin
          if I = Length(S) // End of WideString --> No low surrogate found
            then raise EWriteError.Create(ERROR_STR);
          HighSurrogate:= S[I];
          Inc(I);
          LowSurrogate:= S[I];
          if not IsUtf16LowSurrogate(LowSurrogate)  // No low surrogate found
            then raise EWriteError.Create(ERROR_STR);

          UCS4:= UTF16SurrogateToInt(HighSurrogate, LowSurrogate);
        end;
      $DC00..$DFFF: // Low surrogate, but no preceeding high surrogate
        raise EWriteError.Create(ERROR_STR);
      end; {case ...}

      try
        FOutputSource.WriteUCS4Char(UCS4, BytesUsed);
      except
        on EConvertError do
          if UseCharRefs then begin
            CharRef := XmlIntToCharRefHex(UCS4);
            BytesUsed := 0;
            for J := 1 to Length(CharRef) do begin
              FOutputSource.WriteUCS4Char(Ord(CharRef[J]), BytesUsed_2);
              BytesUsed := BytesUsed + BytesUsed_2;
            end;
          end else
            raise;
      end;

      // Update position properties:
      case UCS4 of
        LF: begin
          Inc(FLineFeedCount);
          FColumnCount := 0;
          FTabCount := 0;
        end;
        TAB: begin
          Inc(FTabCount);
          Inc(FColumnCount);
        end
      else
        Inc(FColumnCount);
      end;
      FByteCount := FByteCount + BytesUsed;
      Inc(FCharacterCount);

      Inc(I);
    end; {while ...}

  except
    on EConvertError do raise EWriteError.Create(ERROR_STR);
  end;
end;

procedure TXmlStreamBuilder.WriteWideStrings(const Sender: TXmlCustomReader;
                                             const Locator: IDomLocator;
                                             const XmlStrgs: array of WideString;
                                             const UseCharRefs: Boolean);
var
  I: Longint;
begin
  if not Assigned(FOutputSource) then Exit;
  for I := 0 to High(XmlStrgs) do begin
    try
      WriteWideString(XmlStrgs[I], UseCharRefs);
    except
      SendErrorNotification(Sender, ET_INVALID_CHARACTER, Locator, XmlStrgs[I], '');  
    end;
  end;
end;

procedure TXmlStreamBuilder.ProcessSignal(const Signal: TXmlSignal);
begin
  if not (Signal is TXmlAttributeDefinitionSignal) then
    CheckAttListDeclarationClosed(Signal.Reader, Signal);

  if not (Signal is TXmlAttributeSignal) then
    CheckStartElementClosed(Signal.Reader, Signal, Signal);

  if Signal is TXmlAttributeDefinitionSignal then begin
    WriteAttributeDefinitionSignal(TXmlAttributeDefinitionSignal(Signal));

  end else if Signal is TXmlAttributeSignal then begin
    WriteAttributeSignal(TXmlAttributeSignal(Signal));

  end else if Signal is TXmlCDataSignal then begin
    WriteCDataSignal(TXmlCDataSignal(Signal));

  end else if Signal is TXmlCommentSignal then begin
    WriteCommentSignal(TXmlCommentSignal(Signal));

  end else if Signal is TXmlDoctypeSignal then begin
    WriteDoctypeSignal(TXmlDoctypeSignal(Signal));

  end else if Signal is TXmlElementTypeDeclarationSignal then begin
    WriteElementTypeDeclarationSignal(TXmlElementTypeDeclarationSignal(Signal));

  end else if Signal is TXmlEndElementSignal then begin
    WriteEndElementSignal(TXmlEndElementSignal(Signal));

  end else if Signal is TXmlEndPrefixMappingSignal then begin
    // do nothing;

  end else if Signal is TXmlEntityDeclarationSignal then begin
    WriteEntityDeclarationSignal(TXmlEntityDeclarationSignal(Signal));

  end else if Signal is TXmlEntityRefSignal then begin
    WriteEntityRefSignal(TXmlEntityRefSignal(Signal));

  end else if Signal is TXmlNotationDeclarationSignal then begin
    WriteNotationDeclarationSignal(TXmlNotationDeclarationSignal(Signal));

  end else if Signal is TXmlParameterEntityDeclarationSignal then begin
    WriteParameterEntityDeclarationSignal(TXmlParameterEntityDeclarationSignal(Signal));

  end else if Signal is TXmlPCDATASignal then begin
    WritePCDATASignal(TXmlPCDATASignal(Signal));

  end else if Signal is TXmlProcessingInstructionSignal then begin
    WriteProcessingInstructionSignal(TXmlProcessingInstructionSignal(Signal));

  end else if Signal is TXmlSkippedEntitySignal then begin
    WriteSkippedEntitySignal(TXmlSkippedEntitySignal(Signal));

  end else if Signal is TXmlStartDocumentSignal then begin
    WriteStartDocumentSignal(TXmlStartDocumentSignal(Signal));

  end else if Signal is TXmlStartDocumentFragmentSignal then begin
    WriteStartDocumentFragmentSignal(TXmlStartDocumentFragmentSignal(Signal));

  end else if Signal is TXmlStartElementSignal then begin
    WriteStartElementSignal(TXmlStartElementSignal(Signal));

  end else if Signal is TXmlStartExtDtdSignal then begin
    WriteStartExtDtdSignal(TXmlStartExtDtdSignal(Signal));

  end else if Signal is TXmlStartIntDtdSignal then begin
    WriteStartIntDtdSignal(TXmlStartIntDtdSignal(Signal));

  end else if Signal is TXmlStartPrefixMappingSignal then begin
    // do nothing;

  end else if Signal is TXmlCompletedSignal then begin
    WriteCompletedSignal(TXmlCompletedSignal(Signal));

  end else if Signal is TXmlAbortedSignal then begin
    Reset;

  end else
    raise EParserException.Create('Internal Parser Exception');

end;

procedure TXmlStreamBuilder.WriteAttributeSignal(const Signal: TXmlAttributeSignal);
begin
  with Signal do begin
    WriteWideStrings(Reader, Signal, [' '], False);
    DoBeforeWrite(xmlAttribute, Signal); // Trigger the OnBeforeWrite event immediately before serializing the attribute name.
    WriteWideStrings(Reader, Signal, [Name, '="'], False);
    WriteWideStrings(Reader, Signal, [Value], True);
    WriteWideStrings(Reader, Signal, ['"'], False);
  end;
  DoAfterWrite(xmlAttribute, Signal);  
end;

procedure TXmlStreamBuilder.WriteCDATASignal(const Signal: TXmlCDataSignal);
begin
  DoBeforeWrite(xmlCDATA, Signal);
  with Signal do begin
    WriteWideStrings(Reader, Signal, ['<![CDATA[', Data, ']]>'], False);
  end;
  DoAfterWrite(xmlCDATA, Signal);
end;

procedure TXmlStreamBuilder.WriteCommentSignal(const Signal: TXmlCommentSignal);
begin
  DoBeforeWrite(xmlComment, Signal);
  with Signal do begin
    if FOpenElementsCount > 0
      then WriteWideStrings(Reader, Signal, ['<!--', Data, '-->'], False)
      else WriteWideStrings(Reader, Signal, ['<!--', Data, '-->'#10], False);
  end;
  DoAfterWrite(xmlComment, Signal);
end;

procedure TXmlStreamBuilder.WriteDoctypeSignal(const Signal: TXmlDoctypeSignal);
const
  SQ: WideString = #39; // code of '
  DQ: WideString = #34; // code of "
var
  Qm: WideString;
begin                                   
  DoBeforeWrite(xmlDoctype, Signal);
  with Signal do begin
    WriteWideStrings(Reader, Signal, ['<!DOCTYPE ', DoctypeName], False);
    if SystemId = '' then begin
      if PublicId <> '' then
        WriteWideStrings(Reader, Signal, [WideString(' PUBLIC "'), PublicId, WideString('"')], False);
    end else begin
      if Pos(DQ, SystemId) = 0
        then Qm := DQ
        else Qm := SQ;
      if PublicId = ''
        then WriteWideStrings(Reader, Signal, [WideString(' SYSTEM '), Qm, SystemId, Qm], False)
        else WriteWideStrings(Reader, Signal, [WideString(' PUBLIC "'), PublicId, WideString('" '), qm, SystemId, qm], False);
    end;
    if Length(Data) = 0
      then WriteWideStrings(Reader, Signal, [' >'#10], False)
      else WriteWideStrings(Reader, Signal, [' [',Data,'] >'#10], False);
  end;
  DoAfterWrite(xmlDoctype, Signal);
end;

procedure TXmlStreamBuilder.WriteEndElementSignal(const Signal: TXmlEndElementSignal);
begin
  DoBeforeWrite(xmlEndTag, Signal);
  with Signal do begin
    if Signal.ShortForm then
      WriteWideStrings(Reader, Signal, ['/>'], False)
    else
      WriteWideStrings(Reader, Signal, ['</', TagName, '>'], False);
    Dec(FOpenElementsCount);
    if FOpenElementsCount = 0 then
      WriteWideStrings(Reader, Signal, [#10], False);
  end;
  DoAfterWrite(xmlEndTag, Signal);
end;

procedure TXmlStreamBuilder.WriteEntityRefSignal(const Signal: TXmlEntityRefSignal);
begin
  DoBeforeWrite(xmlEntityRef, Signal);
  with Signal do begin
    WriteWideStrings(Reader, Signal,['&', EntityName, ';'], False);
  end;
  DoAfterWrite(xmlEntityRef, Signal);
end;

procedure TXmlStreamBuilder.WriteCompletedSignal(const Signal: TXmlCompletedSignal);
begin
  ResetCurrentCodecClass;
  FAttListDeclIsOpen := False;
  FStartElementIsOpen := False;
  FOpenElementsCount := 0;
end;

procedure TXmlStreamBuilder.WritePCDATASignal(const Signal: TXmlPCDATASignal);
var
  I: Integer;
  Content: TUtilsCustomWideStr;
  S: WideString;
begin
  DoBeforeWrite(xmlPCDATA, Signal);
  with Signal do begin
    Content:= TUtilsCustomWideStr.Create;
    try
      for I := 1 to Length(Data) do begin
        case Ord(Data[I]) of
          AMP: Content.AddWideString('&amp;'); // Ampersand ('&')
          LT:  Content.AddWideString('&lt;');  // Less than ('<')
          GT:  Content.AddWideString('&gt;');  // Greater than ('>')
          CR:  Content.AddWideString('&#xD;'); // Carriage Return
        else
          Content.AddWideChar(Data[I]);
        end;
      end;
      S := Content.Value;
    finally
      Content.Free;
    end;

    WriteWideStrings(Reader, Signal, [S], True);
  end;
  DoAfterWrite(xmlPCDATA, Signal);
end;

procedure TXmlStreamBuilder.WriteProcessingInstructionSignal(const Signal: TXmlProcessingInstructionSignal);
begin
  DoBeforeWrite(xmlProcessingInstruction, Signal);
  with Signal do begin
    if Data = '' then begin
      if FOpenElementsCount > 0
        then WriteWideStrings(Reader, Signal, ['<?', Target, '?>'], False)
        else WriteWideStrings(Reader, Signal, ['<?', Target, '?>'#10], False);
    end else begin
      if FOpenElementsCount > 0
        then WriteWideStrings(Reader, Signal, ['<?', Target, ' ', Data, '?>'], False)
        else WriteWideStrings(Reader, Signal, ['<?', Target, ' ', Data, '?>'#10], False);
    end;
  end;
  DoAfterWrite(xmlProcessingInstruction, Signal);
end;

procedure TXmlStreamBuilder.WriteSkippedEntitySignal(const Signal: TXmlSkippedEntitySignal);
begin
  // Do nothing.
end;

procedure TXmlStreamBuilder.WriteStartDocumentSignal(const Signal: TXmlStartDocumentSignal);
var
  NewCodecClass: TUnicodeCodecClass;
  NewEncName: WideString;
begin
  with Signal do begin
    FAttListDeclIsOpen := False;
    FStartElementIsOpen := False;
    FOpenElementsCount := 0;
    FByteCount:= 0;
    FCharacterCount:= 0;
    FColumnCount:= 0;
    FLineFeedCount:= 0;
    FTabCount:= 0;
    NewEncName := EncodingName;
    if DefaultEncoding = '' then begin
      if NewEncName = ''
        then NewCodecClass := TUTF8Codec
        else NewCodecClass := StrToEncoding(NewEncName);
    end else begin
      NewEncName := DefaultEncoding;
      NewCodecClass := DefaultCodecClass;
    end;

    if Assigned(NewCodecClass) then begin

      DoBeforeWrite(xmlXmlDeclaration, Signal);
      PutCurrentCodecClass(NewCodecClass);
      FCurrentEncoding := NewEncName;

      WriteByteOrderMark(Reader, Signal, FByteCount);

      if IncludeXmlDecl then begin
        if Version = ''
          then WriteWideStrings(Reader, Signal, ['<?xml version="1.0"'], False)
          else WriteWideStrings(Reader, Signal, ['<?xml version="', Version, '"'], False);
        if CurrentEncoding <> '' then
          WriteWideStrings(Reader, Signal, [' encoding="', CurrentEncoding, '"'], False);
        case StandaloneDecl of
          STANDALONE_YES: WriteWideStrings(Reader, Signal, [' standalone="yes"'], False);
          STANDALONE_NO: WriteWideStrings(Reader, Signal, [' standalone="no"'], False);
        end;
        WriteWideStrings(Reader, Signal, ['?>'], False);
      end;
      DoAfterWrite(xmlXmlDeclaration, Signal);

    end else
      SendErrorNotification(Reader, ET_ENCODING_NOT_SUPPORTED, Signal, NewEncName, '');
  end;
end;

procedure TXmlStreamBuilder.WriteStartDocumentFragmentSignal(const Signal: TXmlStartDocumentFragmentSignal);
var
  NewCodecClass: TUnicodeCodecClass;
  NewEncName: WideString;
begin
  with Signal do begin
    FAttListDeclIsOpen := False;
    FStartElementIsOpen := False;
    FOpenElementsCount := 0;
    FByteCount:= 0;
    FCharacterCount:= 0;
    FColumnCount:= 0;
    FLineFeedCount:= 0;
    FTabCount:= 0;
    NewEncName := EncodingName;

    if DefaultEncoding = '' then begin
      if NewEncName = ''
        then NewCodecClass := TUTF8Codec
        else NewCodecClass := StrToEncoding(NewEncName);
    end else begin
      NewEncName := DefaultEncoding;
      NewCodecClass := DefaultCodecClass;
    end;

    if Assigned(NewCodecClass) then begin
      DoBeforeWrite(xmlTextDeclaration, Signal);
      PutCurrentCodecClass(NewCodecClass);
      FCurrentEncoding := NewEncName;
      WriteByteOrderMark(Reader, Signal, FByteCount);
      DoAfterWrite(xmlTextDeclaration, Signal);
    end else
      SendErrorNotification(Reader, ET_ENCODING_NOT_SUPPORTED, Signal, NewEncName, '');
  end;
end;

procedure TXmlStreamBuilder.WriteStartElementSignal(const Signal: TXmlStartElementSignal);
begin
  DoBeforeWrite(xmlStartTag, Signal);
  with Signal do begin
    Inc(FOpenElementsCount);
    FStartElementIsOpen := True;
    WriteWideStrings(Reader, Signal, ['<', TagName], False);
  end;
end;

procedure TXmlStreamBuilder.WriteAttributeDefinitionSignal(const Signal: TXmlAttributeDefinitionSignal);

  function XmlDataTypeToAttTypeStr(const DataType: TXmlDataType): WideString;
  begin
    case DataType of
      AS_STRING_DATATYPE:   Result := 'CDATA';
      AS_ID_DATATYPE:       Result := 'ID';
      AS_IDREF_DATATYPE:    Result := 'IDREF';
      AS_IDREFS_DATATYPE:   Result := 'IDREFS';
      AS_ENTITY_DATATYPE:   Result := 'ENTITY';
      AS_ENTITIES_DATATYPE: Result := 'ENTITIES';
      AS_NMTOKEN_DATATYPE:  Result := 'NMTOKEN';
      AS_NMTOKENS_DATATYPE: Result := 'NMTOKENS';
      AS_NOTATION_DATATYPE: Result := 'NOTATION';
    else
      raise EConvertError.Create('Datatype conversion not supported');;
    end;
  end;

const
  DQ: WideChar = #$22; // code of "
  SQ: WideChar = #$27; // code of '
var
  I: Integer;
begin
  with Signal do begin
    CheckAttListDeclarationOpen(Reader, Signal, ElementName);
    WriteWideStrings(Reader, Signal, ['          ', AttributeName, ' '], False);
    if Enumeration.Count > 0 then begin
      WriteWideStrings(Reader, Signal, ['('], False);
      for I := 0 to Pred(Enumeration.Count) do begin
        WriteWideStrings(Reader, Signal, [' ',Enumeration[I],' '], False);
        if I < Pred(Enumeration.Count) then
          WriteWideStrings(Reader, Signal, ['|'], False);
      end;
      WriteWideStrings(Reader, Signal, [') '], False);
    end else
      WriteWideStrings(Reader, Signal, [XmlDataTypeToAttTypeStr(AttributeType), ' '], False);
    case Constraint of
      AVC_FIXED:    WriteWideStrings(Reader, Signal, [' #FIXED'], False);
      AVC_IMPLIED:  WriteWideStrings(Reader, Signal, [' #IMPLIED'], False);
      AVC_REQUIRED: WriteWideStrings(Reader, Signal, [' #REQUIRED'], False);
    end;
    if Constraint in [AVC_DEFAULT, AVC_FIXED] then
      if Pos(DQ, DefaultValue) > 0
        then WriteWideStrings(Reader, Signal, [' ', SQ, DefaultValue, SQ, #10], False)
        else WriteWideStrings(Reader, Signal, [' ', DQ, DefaultValue, DQ, #10], False);
  end;
end;

procedure TXmlStreamBuilder.WriteElementTypeDeclarationSignal(const Signal: TXmlElementTypeDeclarationSignal);
begin
  DoBeforeWrite(xmlElementDecl, Signal);
  with Signal do
    WriteWideStrings(Reader, Signal, [#10'<!ELEMENT ', ElementName, ' ', Data, ' >'], False);
  DoAfterWrite(xmlElementDecl, Signal);
end;

procedure TXmlStreamBuilder.WriteEntityDeclarationSignal(const Signal: TXmlEntityDeclarationSignal);
const
  SQ: WideChar = #39; // code of '
  DQ: WideChar = #34; // code of "
begin
  DoBeforeWrite(xmlEntityDecl, Signal);
  with Signal do begin
    WriteWideStrings(Reader, Signal, [#10'<!ENTITY ', EntityName, ' '], False);
    if ((PublicId = '') and (SystemId = '')) then begin
      if Pos(DQ, EntityValue) > 0
        then WriteWideStrings(Reader, Signal, [SQ, EntityValue, SQ], False)
        else WriteWideStrings(Reader, Signal, [DQ, EntityValue, DQ], False);
    end else begin
      if PublicId = '' then begin
        if Pos(DQ, SystemId) > 0
          then WriteWideStrings(Reader, Signal, ['SYSTEM ', SQ, SystemId, SQ], False)
          else WriteWideStrings(Reader, Signal, ['SYSTEM ', DQ, SystemId, DQ], False);
      end else begin
        if SystemId = '' then begin
          WriteWideStrings(Reader, Signal, [' PUBLIC "', PublicId, '"'], False);
        end else begin
          if Pos(DQ, SystemId) > 0
            then WriteWideStrings(Reader, Signal, ['PUBLIC "', PublicId, '" ', SQ, SystemId, SQ], False)
            else WriteWideStrings(Reader, Signal, ['PUBLIC "', PublicId, '" "', SystemId, '"'], False);
        end;
      end; {if ...}
      if NotationName <> '' then
        WriteWideStrings(Reader, Signal, [' NDATA ', NotationName], False);
    end;
    WriteWideStrings(Reader, Signal, ['>'], False);
  end;
  DoAfterWrite(xmlEntityDecl, Signal);
end;

procedure TXmlStreamBuilder.WriteNotationDeclarationSignal(const Signal: TXmlNotationDeclarationSignal);
const
  SQ: WideChar = #39; // code of '
  DQ: WideChar = #34; // code of "
begin
  DoBeforeWrite(xmlNotationDecl, Signal);
  with Signal do begin
    WriteWideStrings(Reader, Signal, [#10'<!NOTATION ', NotationName, ' '], False);
    if PublicId = '' then begin
      if Pos(DQ, SystemId) > 0
        then WriteWideStrings(Reader, Signal, ['SYSTEM ', SQ, SystemId, SQ], False)
        else WriteWideStrings(Reader, Signal, ['SYSTEM ', DQ, SystemId, DQ], False);
    end else begin
      if SystemId = '' then begin
        WriteWideStrings(Reader, Signal, [' PUBLIC "',PublicId,'"'], False);
      end else begin
        if Pos(DQ, SystemId) > 0
          then WriteWideStrings(Reader, Signal, ['PUBLIC "', PublicId, '" ', SQ, SystemId, SQ], False)
          else WriteWideStrings(Reader, Signal, ['PUBLIC "', PublicId, '" "', SystemId, '"'], False);
      end;
    end; {if ...}
    WriteWideStrings(Reader, Signal, ['>'], False);
  end;
  DoAfterWrite(xmlNotationDecl, Signal);
end;

procedure TXmlStreamBuilder.WriteParameterEntityDeclarationSignal(const Signal: TXmlParameterEntityDeclarationSignal);
const
  SQ: WideChar = #39; // code of '
  DQ: WideChar = #34; // code of "
begin
  DoBeforeWrite(xmlParameterEntityDecl, Signal);
  with Signal do begin
    WriteWideStrings(Reader, Signal, [#10'<!ENTITY % ', entityName, ' '], False);
    if ((PublicId = '') and (SystemId = '')) then begin
      if Pos(DQ, EntityValue) > 0
        then WriteWideStrings(Reader, Signal, [SQ, EntityValue, SQ], False)
        else WriteWideStrings(Reader, Signal, [DQ, EntityValue, DQ], False);
    end else begin
      if PublicId = '' then begin
        if Pos(DQ, SystemId) > 0
          then WriteWideStrings(Reader, Signal, ['SYSTEM ', SQ, SystemId, SQ], False)
          else WriteWideStrings(Reader, Signal, ['SYSTEM ', DQ, SystemId, DQ], False);
      end else begin
        if SystemId = '' then begin
          WriteWideStrings(Reader, Signal, [' PUBLIC "',PublicId,'"'], False);
        end else begin
          if Pos(DQ, SystemId) > 0
            then WriteWideStrings(Reader, Signal, ['PUBLIC "', PublicId, '" ', SQ, SystemId, SQ], False)
            else WriteWideStrings(Reader, Signal, ['PUBLIC "', PublicId, '" "', SystemId, '"'], False);
        end;
      end;
    end;
    WriteWideStrings(Reader, Signal, ['>'], False);
  end;
  DoAfterWrite(xmlParameterEntityDecl, Signal);
end;

procedure TXmlStreamBuilder.WriteStartExtDtdSignal(const Signal: TXmlStartExtDtdSignal);
var
  NewCodecClass: TUnicodeCodecClass;
  NewEncName: WideString;
begin
  with Signal do begin
    FAttListDeclIsOpen := False;
    FByteCount:= 0;
    FCharacterCount:= 0;
    FColumnCount:= 0;
    FLineFeedCount:= 0;
    FTabCount:= 0;

    NewEncName := EncodingName;
    if DefaultEncoding = '' then begin
      if NewEncName = ''
        then NewCodecClass := TUTF8Codec
        else NewCodecClass := StrToEncoding(NewEncName);
    end else begin
      NewEncName := DefaultEncoding;
      NewCodecClass := DefaultCodecClass;
    end;

    if Assigned(NewCodecClass) then begin
      DoBeforeWrite(xmlTextDeclaration, Signal);

      PutCurrentCodecClass(NewCodecClass);

      WriteByteOrderMark(Reader, Signal, FByteCount);

      if IncludeXmlDecl then begin
        if Version = ''
          then WriteWideStrings(Reader, Signal, ['<?xml version="1.0"'], False)
          else WriteWideStrings(Reader, Signal, ['<?xml version="', Version, '"'], False);
        if NewEncName <> '' then
          WriteWideStrings(Reader, Signal, [' encoding="', NewEncName, '"'], False);
        WriteWideStrings(Reader, Signal, ['?>'#10], False);
      end;
      
      DoAfterWrite(xmlTextDeclaration, Signal);
    end else
      SendErrorNotification(Reader, ET_ENCODING_NOT_SUPPORTED, Signal, NewEncName, '');
  end;
end;

procedure TXmlStreamBuilder.WriteStartIntDtdSignal(const Signal: TXmlStartIntDtdSignal);
begin
  ResetCurrentCodecClass;
  FAttListDeclIsOpen := False;
end;

procedure TXmlStreamBuilder.Reset;
begin
  ResetCurrentCodecClass;
  FAttListDeclIsOpen := False;
  FStartElementIsOpen := False;
  FOpenElementsCount:= 0;
end;



// +++++++++++++++++++++++++ TXmlCustomReader ++++++++++++++++++++++++++
constructor TXmlCustomReader.Create(AOwner: TComponent);
begin
  inherited;
  FDOMImpl:= nil;
  FNextHandler := nil;
end;

procedure TXmlCustomReader.Notification(AComponent: TComponent;
                                        Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then begin
    if AComponent = FNextHandler then FNextHandler := nil;
    if AComponent = FDOMImpl then FDOMImpl:= nil;
  end;
end;

procedure TXmlCustomReader.ResolveResourceAsWideString(const BaseURI,
                                                             PublicId,
                                                             SystemId: WideString;
                                                         out S: WideString;
                                                         out Error: TXmlErrorType);
var
  PId, SId: WideString;
begin
  PId := PublicId;
  SId := SystemId;
  if Assigned(DomImpl) then begin
    DomImpl.ResolveResourceAsWideString(BaseUri, PId, SId, S, Error)
  end else begin
    S := '';
    Error := ET_EXT_ENTITY_RESOURCE_NOT_FOUND;
  end;
end;

procedure TXmlCustomReader.SendErrorNotification(const XmlErrorType: TXmlErrorType;
                                                 const Location: IDomLocator;
                                                 const Code,
                                                       Clue: WideString);
var
  Error: TDomError;
  Ok: Boolean;
begin
  Error := TDomError.CreateFromLocator(XmlErrorType, Location, Code, Clue);
  try
    if Assigned(FOnError) then
      FOnError(Self, Error);

    if Assigned(DomImpl) then begin
      Ok := DomImpl.HandleError(Self, Error);
    end else if Error.Severity = DOM_SEVERITY_FATAL_ERROR
      then Ok := False
      else Ok := True;

    if not Ok then
      raise EParserException.Create('Signal Processing Exception');
  finally
    Error.Free;
  end;
end;

procedure TXmlCustomReader.SetDomImpl(const Impl: TDomImplementation);
begin
  if FDOMImpl = Impl then Exit;
  {$IFDEF VER140+}
  if Assigned(FDOMImpl)
    then FDOMImpl.RemoveFreeNotification(Self);
  {$ENDIF}
  {$IFDEF LINUX}
  if Assigned(FDOMImpl)
    then FDOMImpl.RemoveFreeNotification(Self);
  {$ENDIF}
  FDOMImpl := Impl;
  if Assigned(Impl)
    then Impl.FreeNotification(Self);
end;



// ++++++++++++++++++++++ TXmlStandardDocReader ++++++++++++++++++++++++
procedure TXmlStandardDocReader.SendAbortedSignal(const Locator: IDomLocator);
var
  XmlAbortedSignal: TXmlAbortedSignal;
begin
  if Assigned(NextHandler) then begin
    XmlAbortedSignal := TXmlAbortedSignal.CreateFromLocator(Self, Locator);
    try
      NextHandler.ProcessSignal(XmlAbortedSignal);
    finally
      XmlAbortedSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteAttribute(const Locator: IDomLocator;
                                               const Name,
                                                     Value: WideString);
var
  XmlAttributeSignal: TXmlAttributeSignal;
begin
  if Assigned(NextHandler) then begin
    XmlAttributeSignal := TXmlAttributeSignal.CreateFromLocator(Self, Locator);
    try
      XmlAttributeSignal.DataType := AS_STRING_DATATYPE;  // Remark: AS_STRING_DATATYPE is the default for unkown attribute data types.
      XmlAttributeSignal.Name := Name;
      XmlAttributeSignal.Value := Value;
      NextHandler.ProcessSignal(XmlAttributeSignal);
    finally
      XmlAttributeSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteCDATA(const Locator: IDomLocator;
                                           const Content: WideString);
var
  XmlCDATASignal: TXmlCDATASignal;
begin
  if Assigned(NextHandler) then begin
    XmlCDATASignal := TXmlCDATASignal.CreateFromLocator(Self, Locator);
    try
      XmlCDATASignal.Data := Content;
      NextHandler.ProcessSignal(XmlCDATASignal);
    finally
      XmlCDATASignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteCharRefDec(const Locator: IDomLocator;
                                                const Content: WideString);
var
  XmlPCDATASignal: TXmlPCDATASignal;
  S: TUtilsCustomWideStr;
begin
  S := TUtilsCustomWideStr.Create;
  try
    try
      S.AddUCS4Char(StrToInt64(Content));

      if Assigned(NextHandler) then begin
        XmlPCDATASignal := TXmlPCDATASignal.CreateFromLocator(Self, Locator);
        try
          XmlPCDATASignal.CharRefGenerated := True;
          XmlPCDATASignal.Data := S.Value;
          NextHandler.ProcessSignal(XmlPCDATASignal);
        finally
          XmlPCDATASignal.Free;
        end;
      end;

    except
      SendErrorNotification(ET_INVALID_CHAR_REF, Locator,'&' + Content + ';', '');
    end;
  finally
    S.Free;
  end;
end;

procedure TXmlStandardDocReader.WriteCharRefHex(const Locator: IDomLocator;
                                                const Content: WideString);
var
  XmlPCDATASignal: TXmlPCDATASignal;
  S: TUtilsCustomWideStr;
begin
  S := TUtilsCustomWideStr.Create;
  try
    try
      S.AddUCS4Char(StrToInt64(Concat('$', Content)));

      if Assigned(NextHandler) then begin
        XmlPCDATASignal := TXmlPCDATASignal.CreateFromLocator(Self, Locator);
        try
          XmlPCDATASignal.CharRefGenerated := True;
          XmlPCDATASignal.Data := S.Value;
          NextHandler.ProcessSignal(XmlPCDATASignal);
        finally
          XmlPCDATASignal.Free;
        end;
      end;

    except
      SendErrorNotification(ET_INVALID_CHAR_REF, Locator, '&x' + Content + ';', '');
    end;
  finally
    S.Free;
  end;
end;

procedure TXmlStandardDocReader.WriteComment(const Locator: IDomLocator;
                                             const Content: WideString);
var
  XmlCommentSignal: TXmlCommentSignal;
begin
  if Assigned(NextHandler) then begin
    XmlCommentSignal := TXmlCommentSignal.CreateFromLocator(Self, Locator);
    try
      XmlCommentSignal.Data := Content;
      NextHandler.ProcessSignal(XmlCommentSignal);
    finally
      XmlCommentSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WritePCDATA(const Locator: IDomLocator;
                                            const Content: WideString);
var
  XmlPCDATASignal: TXmlPCDATASignal;
begin
  if Assigned(NextHandler) then begin
    XmlPCDATASignal := TXmlPCDATASignal.CreateFromLocator(Self, Locator);
    try
      XmlPCDATASignal.CharRefGenerated := False;
      XmlPCDATASignal.Data := Content;
      NextHandler.ProcessSignal(XmlPCDATASignal);
    finally
      XmlPCDATASignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteProcessingInstruction(const Locator: IDomLocator;
                                                           const Content: WideString);

  procedure AnalysePI(const S: WideString;
                        out Target,
                            Data: WideString);
  var
    C: PWideChar;
  begin
    // Extract Target:
    C := PWideChar(S);
    while not IsXmlWhiteSpaceOrNull(C^) do
      Inc(C);
    SetString(Target, PWideChar(S), C - PWideChar(S));

    // Skip white space:
    while IsXmlWhiteSpace(C^) do
      Inc(C);

    // Extract Data:
    Data := Copy(S, C - PWideChar(S) + 1, Length(S));
  end;

var
  XmlProcessingInstructionSignal: TXmlProcessingInstructionSignal;
  TargetName, PIData: WideString;
begin
  if Assigned(NextHandler) then begin
    XmlProcessingInstructionSignal := TXmlProcessingInstructionSignal.CreateFromLocator(Self, Locator);
    try
      AnalysePI(Content,TargetName, PIData);
      XmlProcessingInstructionSignal.Target := TargetName;
      XmlProcessingInstructionSignal.Data := PIData;
      NextHandler.ProcessSignal(XmlProcessingInstructionSignal);
    finally
      XmlProcessingInstructionSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteStartDocument(const Locator: IDomLocator;
                                                   const InputEnc,
                                                         Version,
                                                         EncName: WideString;
                                                         SdDl: TDomStandalone);
var
  XmlStartDocumentSignal: TXmlStartDocumentSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartDocumentSignal := TXmlStartDocumentSignal.CreateFromLocator(Self, Locator);
    try
      XmlStartDocumentSignal.InputEncoding := InputEnc;
      XmlStartDocumentSignal.Version := Version;
      XmlStartDocumentSignal.EncodingName := EncName;
      XmlStartDocumentSignal.StandaloneDecl := SdDl;
      NextHandler.ProcessSignal(XmlStartDocumentSignal);
    finally
      XmlStartDocumentSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteStartDocumentFragment(const Locator: IDomLocator;
                                                           const EncName: WideString);
var
  XmlStartDocumentFragmentSignal: TXmlStartDocumentFragmentSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartDocumentFragmentSignal := TXmlStartDocumentFragmentSignal.CreateFromLocator(Self, Locator);
    try
      XmlStartDocumentFragmentSignal.EncodingName := EncName;
      NextHandler.ProcessSignal(XmlStartDocumentFragmentSignal);
    finally
      XmlStartDocumentFragmentSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteStartElement(const Locator: IDomLocator;
                                                  const TagName: WideString);
var
  XmlStartElementSignal: TXmlStartElementSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartElementSignal := TXmlStartElementSignal.CreateFromLocator(Self, Locator);
    try
      XmlStartElementSignal.TagName := TagName;
      NextHandler.ProcessSignal(XmlStartElementSignal);
    finally
      XmlStartElementSignal.Free;
    end;
  end; {if ...}
end;

procedure TXmlStandardDocReader.WriteStartTag(const Locator: IDomLocator;
                                                    Content: WideString;
                                                out TagName: WideString);
const
  NULL:  WideChar = #0; // end of WideString mark
  SQ:    WideChar = #39;  // code of '
  DQ:    WideChar = #34;  // code of "
  EQ:    WideChar = #61;  // code of =
var
  AttrNames: TUtilsWideStringList;
  Head, Tail: PWideChar;
  AttrName, AttrValue: WideString;
  QuotationMark: WideChar;
begin
  AttrNames := TUtilsWideStringList.Create;
  try
    AttrNames.Sorted := True;
    AttrNames.Duplicates := dupError;

    // Find tag name:
    Head := PWideChar(Content);
    Tail := Head;
    while not IsXmlWhiteSpaceOrNull(Tail^) do
      Inc(Tail);
    SetString(TagName, Head, Tail - Head);
    WriteStartElement(Locator, TagName);

    // Skip white space:
    Head := Tail;
    while IsXmlWhiteSpace(Head^) do
      Inc(Head);

    while Head^ <> NULL do begin

      // Find next attribute name:
      Tail := Head;
      while not IsXmlWhiteSpace(Tail^) and not ( (Tail^ = NULL) or (Tail^ = EQ) ) do
        Inc(Tail);
      SetString(AttrName, Head, Tail - Head);

      // Find equation sign and quotation mark:
      Head := Tail;
      while IsXmlWhiteSpace(Head^) do
        Inc(Head);
      if Head^ <> EQ then begin
        SendErrorNotification(ET_MISSING_EQUALITY_SIGN, Locator, '', '=');
        Exit;
      end;
      Inc(Head);
      while IsXmlWhiteSpace(Head^) do
        Inc(Head);
      if not ( (Head^ = SQ) or (Head^ = DQ) ) then begin
        SendErrorNotification(ET_MISSING_QUOTATION_MARK, Locator, '', '"');
        Exit;
      end;
      QuotationMark := WideChar(Head^);
      Inc(Head);
      Tail := Head;

      // Find next attribute value:
      while not ( (Tail^ = NULL) or (Tail^ = QuotationMark) ) do
        Inc(Tail);
      if Tail^ = NULL then begin
        SendErrorNotification(ET_MISSING_QUOTATION_MARK, Locator, '', WideChar(QuotationMark));
        Exit;
      end;
      SetString(AttrValue, Head, Tail - Head);

      // Process the attribute:
      try
        AttrNames.Add(AttrName);
      except
        SendErrorNotification(ET_DOUBLE_ATTRIBUTE_NAME, Locator, AttrName, '');
        Exit;
      end;
      WriteAttribute(Locator, AttrName, AttrValue);

      // Skip white space:
      Head := Tail;
      Inc(Head);
      if not IsXmlWhiteSpaceOrNull(Head^) then begin
        SendErrorNotification(ET_MISSING_WHITE_SPACE, Locator, '', ' ');
        Exit;
      end;
      while IsXmlWhiteSpace(Head^) do
        Inc(Head);
    end; {while ...}
  finally
    AttrNames.Free;
  end;
end;

procedure TXmlStandardDocReader.WriteEndTag(const Locator: IDomLocator;
                                            const Content: WideString);
var
  XmlEndElementSignal: TXmlEndElementSignal;
begin
  if Assigned(NextHandler) then begin
    XmlEndElementSignal := TXmlEndElementSignal.CreateFromLocator(Self, Locator);
    try
      XmlEndElementSignal.TagName := Content;
      NextHandler.ProcessSignal(XmlEndElementSignal);
    finally
      XmlEndElementSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteEmptyElementTag(const Locator: IDomLocator;
                                                     const Content: WideString);
var
  TagName: WideString;
begin
  WriteStartTag(Locator, Content, TagName);
  WriteEndTag(Locator, TagName);
end;

procedure TXmlStandardDocReader.WriteEntityRef(const Locator: IDomLocator;
                                               const Content: WideString);
var
  XmlEntityRefSignal: TXmlEntityRefSignal;
begin
  if Assigned(NextHandler) then begin
    XmlEntityRefSignal := TXmlEntityRefSignal.CreateFromLocator(Self, Locator);
    try
      XmlEntityRefSignal.EntityName := Content;
      NextHandler.ProcessSignal(XmlEntityRefSignal);
    finally
      XmlEntityRefSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteDoctype(const Locator: IDomLocator;
                                             const Content: WideString);

var
  DoctypeDeclTokenizer: TXmlDoctypeDeclTokenizer;
  DoctypeName: WideString;
  IntDtdByteNumber, IntDtdCharNumber, IntDtdLine, IntDtdColumn: Integer;
  IntDtd: WideString;
  PubidLiteral: WideString;
  SystemLiteral: WideString;
  XmlDoctypeSignal: TXmlDoctypeSignal;
begin
  IntDtdByteNumber := 0;
  IntDtdCharNumber := 0;
  IntDtdLine := 1;
  IntDtdColumn := 0;

  with Locator do
    DoctypeDeclTokenizer := TXmlDoctypeDeclTokenizer.Create(Content, Uri,
                              StartByteNumber, StartCharNumber - 1,
                              StartColumnNumber - 1, 0, StartLineNumber);
  try
    with DoctypeDeclTokenizer do begin
      while TokenType <> DOCTYPE_END_OF_SOURCE_TOKEN do begin
        Next;
        if ErrorType <> ET_NONE then begin
          SendErrorNotification(ErrorType, DoctypeDeclTokenizer, TokenValue, Clue);
          Exit;
        end;
        case TokenType of
          DOCTYPE_NAME_TOKEN:
            DoctypeName := TokenValue;
          DOCTYPE_PUBID_TOKEN:
            PubidLiteral := TokenValue;
          DOCTYPE_SYSID_TOKEN:
            SystemLiteral := TokenValue;
          DOCTYPE_INTSUBSET_TOKEN:
            begin
              IntDtdByteNumber := DoctypeDeclTokenizer.GetStartByteNumber;
              IntDtdCharNumber := DoctypeDeclTokenizer.GetStartCharNumber - 1;
              IntDtdColumn := DoctypeDeclTokenizer.GetStartColumnNumber - 1;
              IntDtdLine := DoctypeDeclTokenizer.GetStartLineNumber;
              if IntDtdColumn = -1 then  // Indicates a starting LF
                Dec(IntDtdLine);
              IntDtd := TokenValue;
            end;
        end;
      end;
    end;
  finally
    DoctypeDeclTokenizer.Free;
  end;

  if Assigned(NextHandler) then begin
    XmlDoctypeSignal := TXmlDoctypeSignal.CreateFromLocator(Self, Locator);
    try
      XmlDoctypeSignal.DoctypeName := DoctypeName;
      XmlDoctypeSignal.PublicId := PubidLiteral;
      XmlDoctypeSignal.SystemId := SystemLiteral;
      XmlDoctypeSignal.Data := IntDtd;
      XmlDoctypeSignal.IntSubsetStartByteNumber := IntDtdByteNumber;
      XmlDoctypeSignal.IntSubsetStartCharNumber := IntDtdCharNumber;
      XmlDoctypeSignal.IntSubsetStartColumn := IntDtdColumn;
      XmlDoctypeSignal.IntSubsetStartLine := IntDtdLine;
      NextHandler.ProcessSignal(XmlDoctypeSignal);
    finally
      XmlDoctypeSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDocReader.WriteCompleted(const Locator: IDomLocator);
var
  XmlCompletedSignal: TXmlCompletedSignal;
begin
  if Assigned(NextHandler) then begin
    XmlCompletedSignal := TXmlCompletedSignal.CreateFromLocator(Self, Locator);
    try
      NextHandler.ProcessSignal(XmlCompletedSignal);
    finally
      XmlCompletedSignal.Free;
    end;
  end;
end;

function TXmlStandardDocReader.Parse(const InputSource: TXmlInputSource; CatchExceptions: Boolean = TRUE): Boolean;
var
  XmlTokenizer: TXmlDocTokenizer;
begin
  XmlTokenizer := TXmlDocTokenizer.Create(InputSource);
  try
    Result := True;
    try
      with InputSource do
        WriteStartDocument(XmlTokenizer, InputEncoding, XmlVersion, XmlEncoding, XmlStandalone);
      Parse2(XmlTokenizer);
      WriteCompleted(XmlTokenizer);
    except
      SendAbortedSignal(XmlTokenizer);
      if not CatchExceptions then
        raise;
      Result := False;
    end; {try ...}
  finally
    XmlTokenizer.Free;
  end;
end;

function TXmlStandardDocReader.ParseFragment(const InputSource: TXmlSimpleInputSource): Boolean;
var
  XmlTokenizer: TXmlDocTokenizer;
begin
  XmlTokenizer := TXmlDocTokenizer.Create(InputSource);
  try
    Result := True;
    try
      if not Assigned(InputSource) then Exit;
      WriteStartDocumentFragment(XmlTokenizer, InputSource.InputEncoding);
      Parse2(XmlTokenizer);
      WriteCompleted(XmlTokenizer);
    except
      SendAbortedSignal(XmlTokenizer);
      Result := False;
    end; {try ...}
  finally
    XmlTokenizer.Free;
  end;
end;

procedure TXmlStandardDocReader.Parse2(const XmlTokenizer: TXmlDocTokenizer);
var
  Dummy: WideString;
begin
  with XmlTokenizer do begin
    while TokenType <> XML_END_OF_SOURCE_TOKEN do begin
      Next;
      if ErrorType <> ET_NONE then
        SendErrorNotification(ErrorType, XmlTokenizer, TokenValue, Clue);
      // For speed optimization, the case statements are ordered according to
      // what I guess is their frequency in a typical XML document.
      case TokenType of
        XML_PCDATA_TOKEN:            WritePCDATA(XmlTokenizer, TokenValue);
        XML_START_TAG_TOKEN:         WriteStartTag(XmlTokenizer, TokenValue ,Dummy);
        XML_END_TAG_TOKEN:           WriteEndTag(XmlTokenizer, TokenValue);
        XML_ENTITY_REF_TOKEN:        WriteEntityRef(XmlTokenizer, TokenValue);
        XML_EMPTY_ELEMENT_TAG_TOKEN: WriteEmptyElementTag(XmlTokenizer, TokenValue);
        XML_CHAR_REF_HEX_TOKEN:      WriteCharRefHex(XmlTokenizer, TokenValue);
        XML_CHAR_REF_DEC_TOKEN:      WriteCharRefDec(XmlTokenizer, TokenValue);
        XML_COMMENT_TOKEN:           WriteComment(XmlTokenizer, TokenValue);
        XML_PI_TOKEN:                WriteProcessingInstruction(XmlTokenizer, TokenValue);
        XML_CDATA_TOKEN:             WriteCDATA(XmlTokenizer, TokenValue);
        XML_DOCTYPE_TOKEN:           WriteDoctype(XmlTokenizer, TokenValue);
      end;
    end;
  end;
end;



// +++++++++++++++++++++ TXmlStandardDtdReader +++++++++++++++++++++
constructor TXmlStandardDtdReader.Create(AOwner: TComponent);
begin
  inherited;
  FAttrListDeclNames := TUtilsWideStringList.Create;
  FPERepository := TDomPERepository.Create(Self);
end;

destructor TXmlStandardDtdReader.Destroy;
begin
  FPERepository.Free;
  FAttrListDeclNames.Free;
  inherited;
end;

procedure TXmlStandardDtdReader.PEReferenceEventHandler(      Sender: TObject;
                                                        const Locator: IDomLocator);
var
  XmlPEReferenceFoundSignal: TXmlPEReferenceFoundSignal;
begin
  if Assigned(NextHandler) then begin
    XmlPEReferenceFoundSignal := TXmlPEReferenceFoundSignal.CreateFromLocator(Self, Locator);
    try
      NextHandler.ProcessSignal(XmlPEReferenceFoundSignal);
    finally
      XmlPEReferenceFoundSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDtdReader.PEProcessingAttListDeclEventHandler(      Sender: TObject;
                                                                    const ElementName: WideString;
                                                                    const Locator: IDomLocator);
begin
  // Keep track of the element types of attribute-list declarations and warn the
  // application when detecting a duplicate:
  if FAttrListDeclNames.IndexOf(ElementName) = -1
    then FAttrListDeclNames.Add(ElementName)
    else SendErrorNotification(ET_DOUBLE_ATTLISTDECL, Locator, ElementName, '');
end;

procedure TXmlStandardDtdReader.SendAbortedSignal(const Locator: IDomLocator);
var
  XmlAbortedSignal: TXmlAbortedSignal;
begin
  if Assigned(NextHandler) then begin
    XmlAbortedSignal := TXmlAbortedSignal.CreateFromLocator(Self, Locator);
    try
      NextHandler.ProcessSignal(XmlAbortedSignal);
    finally
      XmlAbortedSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDtdReader.SendErrorNotification(const XmlErrorType: TXmlErrorType;
                                                      const Location: IDomLocator;
                                                      const Code,
                                                            Clue: WideString);
begin
  if XmlErrorType in ET_FATAL_ERRORS then begin
    FXmlFatalErrorDetected := True;
  end else if XmlErrorType in ET_ERRORS then
    FXmlErrorDetected := True;
  inherited;
end;

procedure TXmlStandardDtdReader.WriteCompleted(const Locator: IDomLocator);
var
  XmlCompletedSignal: TXmlCompletedSignal;
begin
  if Assigned(NextHandler) then begin
    XmlCompletedSignal := TXmlCompletedSignal.CreateFromLocator(Self, Locator);
    try
      NextHandler.ProcessSignal(XmlCompletedSignal);
    finally
      XmlCompletedSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDtdReader.WriteStartExtDtd(const Locator: IDomLocator;
                                                 const InputEnc,
                                                       PubId,
                                                       SysId,
                                                       Version,
                                                       EncName: WideString);
var
  XmlStartExtDtdSignal: TXmlStartExtDtdSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartExtDtdSignal := TXmlStartExtDtdSignal.CreateFromLocator(Self, Locator);
    try
      XmlStartExtDtdSignal.InputEncoding := InputEnc;
      XmlStartExtDtdSignal.PublicId := PubId;
      XmlStartExtDtdSignal.SystemId := SysId;
      XmlStartExtDtdSignal.Version := Version;
      XmlStartExtDtdSignal.EncodingName := EncName;
      NextHandler.ProcessSignal(XmlStartExtDtdSignal);
    finally
      XmlStartExtDtdSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDtdReader.WriteStartIntDtd(const Locator: IDomLocator;
                                                 const SysId: WideString;
                                                 const Standalone: TDomStandalone);
var
  XmlStartIntDtdSignal: TXmlStartIntDtdSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartIntDtdSignal := TXmlStartIntDtdSignal.CreateFromLocator(Self, Locator);
    try
      XmlStartIntDtdSignal.SystemId := SysId;
      XmlStartIntDtdSignal.XmlStandalone := Standalone;
      NextHandler.ProcessSignal(XmlStartIntDtdSignal);
    finally
      XmlStartIntDtdSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDtdReader.WriteSignal(const Signal: TXmlSignal);
var
  NewSignal: TXmlSignal;
begin
  if Assigned(Signal) and Assigned(NextHandler) then begin
    NewSignal := Signal.CloneSignal(Self);
    try
      NextHandler.ProcessSignal(NewSignal);
    finally
      NewSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDtdReader.Parseloop(const Tokenizer: TXmlCustomSubsetTokenizer);
begin
  with Tokenizer do begin
    while not (TokenType = DTD_ABSTRACT_END_OF_SOURCE_TOKEN) do begin
      Next;
      if ErrorType <> ET_NONE then
        SendErrorNotification(ErrorType, Tokenizer, '', Clue);
      if TokenType in [ DTD_ABSTRACT_ATTLIST_DECL_TOKEN,
                        DTD_ABSTRACT_COMMENT_TOKEN,
                        DTD_ABSTRACT_ELEMENT_DECL_TOKEN,
                        DTD_ABSTRACT_ENTITY_DECL_TOKEN,
                        DTD_ABSTRACT_EXT_PARAMETER_ENTITY_REF_TOKEN,
                        DTD_ABSTRACT_NOTATION_DECL_TOKEN,
                        DTD_ABSTRACT_PARAMETER_ENTITY_DECL_TOKEN,
                        DTD_ABSTRACT_PI_TOKEN ] then
        WriteSignal(CurrentSignal);
    end;
  end;
end;

function TXmlStandardDtdReader.ParseExternalSubset(const InputSource: TXmlInputSource): Boolean;
var
  Tokenizer: TXmlExtSubsetTokenizer;
begin
  Tokenizer := TXmlExtSubsetTokenizer.Create(InputSource, FPERepository);
  try
    Tokenizer.OnPEReference := PEReferenceEventHandler;
    Tokenizer.OnProcessingAttListDecl := PEProcessingAttListDeclEventHandler;
    try
      with InputSource do
        WriteStartExtDtd(Tokenizer, InputEncoding, PublicId, SystemId, XmlVersion, XmlEncoding);
      if Tokenizer.ErrorType = ET_NONE
        then Parseloop(Tokenizer)
        else SendErrorNotification(Tokenizer.ErrorType, Tokenizer, '', Tokenizer.Clue);
      WriteCompleted(Tokenizer);
    except
      SendAbortedSignal(Tokenizer);
    end;
  finally
    Tokenizer.Free;
  end;

  Result := not (FXmlFatalErrorDetected or FXmlErrorDetected);
end;

function TXmlStandardDtdReader.ParseInternalSubset(const InputSource: TXmlSimpleInputSource;
                                                   const Standalone: TDomStandalone;
                                                   const ResolveExtPEs: Boolean): Boolean;
var
  Tokenizer: TXmlIntSubsetTokenizer;
begin
  Tokenizer := TXmlIntSubsetTokenizer.Create(InputSource, FPERepository);
  try
    Tokenizer.OnPEReference := PEReferenceEventHandler;
    Tokenizer.OnProcessingAttListDecl := PEProcessingAttListDeclEventHandler;
    Tokenizer.ResolveExtPEs := ResolveExtPEs;
    try
      WriteStartIntDtd(Tokenizer, InputSource.SystemId, Standalone);
      if Tokenizer.ErrorType = ET_NONE
        then Parseloop(Tokenizer)
        else SendErrorNotification(Tokenizer.ErrorType, Tokenizer, '', Tokenizer.Clue);
      WriteCompleted(Tokenizer);
    except
      SendAbortedSignal(Tokenizer);
    end;
  finally
    Tokenizer.Free;
  end;
  Result := not (FXmlFatalErrorDetected or FXmlErrorDetected);
end;

procedure TXmlStandardDtdReader.Prepare;
begin
  FAttrListDeclNames.Clear;
  FPERepository.Clear;
  FXmlFatalErrorDetected := False;
  FXmlErrorDetected := False;
end;



// +++++++++++++++++++++++ TXmlStandardDomReader +++++++++++++++++++++++
constructor TXmlStandardDomReader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIgnoreUnspecified := True;
end;

function TXmlStandardDomReader.GetContextNode: TDomNode;
begin
  Result := FContextNode;
end;

function TXmlStandardDomReader.GetSystemId: WideString;
begin
  if Assigned(ContextNode) then begin
    if Assigned(ContextNode.RootDocument)
      then Result := ContextNode.RootDocument.DocumentUri
      else Result := '';
  end else Result := '';
end;

procedure TXmlStandardDomReader.Parseloop(const SourceNode: TDomNode);
var
  I: Integer;
  ContextNodeBackup: TDomNode;

  procedure ParseElement(const SourceElement: TDomElement);
  var
    I: Integer;

    procedure ParseAttribute(const SourceAttribute: TDomAttr);
    var
      ContextNodeBackup2: TDomNode;
    begin
      ContextNodeBackup2 := FContextNode;
      FContextNode := SourceAttribute;
      try
        with SourceAttribute do
          WriteAttribute(DataType, NodeName, NodeValue);
      finally
        FContextNode := ContextNodeBackup2;
      end;
    end;

  begin
    with SourceElement do begin
      WriteStartElement(NodeName);
      with Attributes do
        if FIgnoreUnspecified then begin
          for I := 0 to Pred(Length) do
            if (Item(I) as TDomAttr).Specified then
              ParseAttribute(Item(I) as TDomAttr);
        end else begin
          for I := 0 to Pred(Length) do
            ParseAttribute(Item(I) as TDomAttr);
        end;
      with ChildNodes do
        for I := 0  to Pred(Length) do
          Parseloop(Item(I));
      WriteEndElement(NodeName);
    end; {with...}
  end;

begin
  ContextNodeBackup := FContextNode;
  FContextNode := SourceNode;
  try
    case SourceNode.NodeType of
      ntElement_Node:
        ParseElement(SourceNode as TDomElement);
      ntText_Node:
        WritePCData(SourceNode.NodeValue,
                    (SourceNode as TDomText).CharRefGenerated);
      ntCDATA_Section_Node:
        WriteCDATA(SourceNode.NodeValue);
      ntEntity_Reference_Node:
        WriteEntityRef(SourceNode.NodeName);
      ntProcessing_Instruction_Node:
        WriteProcessingInstruction(SourceNode.NodeName, SourceNode.NodeValue);
      ntComment_Node:
        WriteComment(SourceNode.NodeValue);
      ntDocument_Node:
        for I := 0  to Pred(SourceNode.ChildNodes.Length) do
          Parseloop(SourceNode.ChildNodes.Item(I));
      ntDocument_Type_Decl_Node:
        WriteDoctype(SourceNode.NodeName,
                     (SourceNode as TDomDocumentTypeDecl).PublicId,
                     (SourceNode as TDomDocumentTypeDecl).SystemId,
                     (SourceNode as TDomDocumentTypeDecl).InternalSubset);
      else
        raise EParserException.Create('Internal Parser error.');
    end;
  finally
    FContextNode := ContextNodeBackup;
  end;
end;

procedure TXmlStandardDomReader.SendAbortedSignal;
var
  XmlAbortedSignal: TXmlAbortedSignal;
begin
  if Assigned(NextHandler) then begin
    XmlAbortedSignal := TXmlAbortedSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, '', nil, nil);  
    try
      NextHandler.ProcessSignal(XmlAbortedSignal);
    finally
      XmlAbortedSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteAttribute(const ADataType: TXmlDataType;
                                               const ANodeName,
                                                     ANodeValue: WideString);
var
  XmlAttributeSignal: TXmlAttributeSignal;
begin
  if Assigned(NextHandler) then begin
    XmlAttributeSignal := TXmlAttributeSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlAttributeSignal.DataType := ADataType;
      XmlAttributeSignal.Name := ANodeName;
      XmlAttributeSignal.Value := ANodeValue;
      NextHandler.ProcessSignal(XmlAttributeSignal);
    finally
      XmlAttributeSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteCDATA(const Content: WideString);
var
  XmlCDATASignal: TXmlCDATASignal;
begin
  if Assigned(NextHandler) then begin
    XmlCDATASignal := TXmlCDATASignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlCDATASignal.Data := Content;
      NextHandler.ProcessSignal(XmlCDATASignal);
    finally
      XmlCDATASignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteComment(const Content: WideString);
var
  XmlCommentSignal: TXmlCommentSignal;
begin
  if Assigned(NextHandler) then begin
    XmlCommentSignal := TXmlCommentSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlCommentSignal.Data := Content;
      NextHandler.ProcessSignal(XmlCommentSignal);
    finally
      XmlCommentSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteDoctype(const DoctypeName,
                                                   PublicId,
                                                   SystemId,
                                                   IntSubset: WideString);
var
  XmlDoctypeSignal: TXmlDoctypeSignal;
begin
  if Assigned(NextHandler) then begin
    XmlDoctypeSignal := TXmlDoctypeSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlDoctypeSignal.DoctypeName := DoctypeName;
      XmlDoctypeSignal.PublicId := PublicId;
      XmlDoctypeSignal.SystemId := SystemId;
      XmlDoctypeSignal.Data := IntSubset;
      NextHandler.ProcessSignal(XmlDoctypeSignal);
    finally
      XmlDoctypeSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteEndElement(const TagName: WideString);
var
  XmlEndElementSignal: TXmlEndElementSignal;
begin
  if Assigned(NextHandler) then begin
    XmlEndElementSignal := TXmlEndElementSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlEndElementSignal.TagName := TagName;
      NextHandler.ProcessSignal(XmlEndElementSignal);
    finally
      XmlEndElementSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteEndPrefixMapping(const Prefix: WideString);
var
  XmlEndPrefixMappingSignal: TXmlEndPrefixMappingSignal;
begin
  if Assigned(NextHandler) then begin
    XmlEndPrefixMappingSignal := TXmlEndPrefixMappingSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlEndPrefixMappingSignal.Prefix := Prefix;
      NextHandler.ProcessSignal(XmlEndPrefixMappingSignal);
    finally
      XmlEndPrefixMappingSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteEntityRef(const EntityName: WideString);
var
  XmlEntityRefSignal: TXmlEntityRefSignal;
begin
  if Assigned(NextHandler) then begin
    XmlEntityRefSignal := TXmlEntityRefSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlEntityRefSignal.EntityName := EntityName;
      NextHandler.ProcessSignal(XmlEntityRefSignal);
    finally
      XmlEntityRefSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteCompleted;
var
  XmlCompletedSignal: TXmlCompletedSignal;
begin
  if Assigned(NextHandler) then begin
    XmlCompletedSignal := TXmlCompletedSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      NextHandler.ProcessSignal(XmlCompletedSignal);
    finally
      XmlCompletedSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WritePCDATA(const Content: WideString;
                                            const CharRefGenerated: Boolean);
var
  XmlPCDATASignal: TXmlPCDATASignal;
begin
  if Content = '' then Exit;

  if Assigned(NextHandler) then begin
    XmlPCDATASignal := TXmlPCDATASignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlPCDATASignal.CharRefGenerated := CharRefGenerated;
      XmlPCDATASignal.Data := Content;
      NextHandler.ProcessSignal(XmlPCDATASignal);
    finally
      XmlPCDATASignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteProcessingInstruction(const Targ,
                                                                 AttribSequence : WideString);
var
  XmlProcessingInstructionSignal: TXmlProcessingInstructionSignal;
begin
  if Assigned(NextHandler) then begin
    XmlProcessingInstructionSignal := TXmlProcessingInstructionSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlProcessingInstructionSignal.Target := Targ;
      XmlProcessingInstructionSignal.Data := AttribSequence;
      NextHandler.ProcessSignal(XmlProcessingInstructionSignal);
    finally
      XmlProcessingInstructionSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteStartDocument(const InputEnc,
                                                         Version,
                                                         EncName: WideString;
                                                         SdDl: TDomStandalone);
var
  XmlStartDocumentSignal: TXmlStartDocumentSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartDocumentSignal := TXmlStartDocumentSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlStartDocumentSignal.InputEncoding  := InputEnc;
      XmlStartDocumentSignal.Version        := Version;
      XmlStartDocumentSignal.EncodingName   := EncName;
      XmlStartDocumentSignal.StandaloneDecl := SdDl;
      NextHandler.ProcessSignal(XmlStartDocumentSignal);
    finally
      XmlStartDocumentSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteStartDocumentFragment(const EncName: WideString);
var
  XmlStartDocumentFragmentSignal: TXmlStartDocumentFragmentSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartDocumentFragmentSignal := TXmlStartDocumentFragmentSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlStartDocumentFragmentSignal.EncodingName  := EncName;
      NextHandler.ProcessSignal(XmlStartDocumentFragmentSignal);
    finally
      XmlStartDocumentFragmentSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteStartElement(const TagName: WideString);
var
  XmlStartElementSignal: TXmlStartElementSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartElementSignal := TXmlStartElementSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlStartElementSignal.TagName := TagName;
      NextHandler.ProcessSignal(XmlStartElementSignal);
    finally
      XmlStartElementSignal.Free;
    end;
  end;
end;

procedure TXmlStandardDomReader.WriteStartPrefixMapping(const Prefix,
                                                              Uri: WideString);
var
  XmlStartPrefixMappingSignal: TXmlStartPrefixMappingSignal;
begin
  if Assigned(NextHandler) then begin
    XmlStartPrefixMappingSignal := TXmlStartPrefixMappingSignal.Create(Self, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, GetSystemId, nil, ContextNode);
    try
      XmlStartPrefixMappingSignal.Prefix    := Prefix;
      XmlStartPrefixMappingSignal.Uri := Uri;
      NextHandler.ProcessSignal(XmlStartPrefixMappingSignal);
    finally
      XmlStartPrefixMappingSignal.Free;
    end;
  end;
end;

function TXmlStandardDomReader.Parse(const SourceNode: TDomNode): Boolean;
begin
  if not Assigned(SourceNode) then
    raise EAccessViolation.Create('Source node not specified.');
    
  Result := True;
  try

    if SourceNode.NodeType = ntDocument_Node then begin
      FContextNode:= SourceNode;
      with (SourceNode as TDomCustomDocument) do
        WriteStartDocument(InputEncoding, XmlVersion, XmlEncoding, XmlStandalone);
      WritePCDATA(#10, False); // Insert LF after XML declaration.
    end else begin
      FContextNode:= nil;
      with SourceNode.RootDocument do
        if XmlEncoding = ''
          then WriteStartDocumentFragment(InputEncoding)
          else WriteStartDocumentFragment(XmlEncoding);
    end;

    Parseloop(SourceNode);

    WriteCompleted;

  except
    SendAbortedSignal;
    Result := False;
  end; {try ...}
end;



// +++++++++++++++++++++++++ TXmlCustomParser +++++++++++++++++++++++++
constructor TXmlCustomParser.Create(AOwner: TComponent);
begin
  inherited;
  FDOMImpl := nil;
end;

procedure TXmlCustomParser.SetDomImpl(const Impl: TDomImplementation);
begin
  if FDOMImpl = Impl then Exit;
  {$IFDEF VER140+}
  if Assigned(FDOMImpl) then
    FDOMImpl.RemoveFreeNotification(Self);
  {$ENDIF}
  {$IFDEF LINUX}
  if Assigned(FDOMImpl) then
    FDOMImpl.RemoveFreeNotification(Self);
  {$ENDIF}
  FDOMImpl := Impl;
  if Assigned(Impl) then
    Impl.FreeNotification(Self);
end;

procedure TXmlCustomParser.Notification(AComponent: TComponent;
                                        Operation: TOperation);
begin
  inherited Notification(AComponent,Operation);
  if (Operation = opRemove) and (AComponent = FDomImpl) then
    FDomImpl:= nil;
end;



{ TXmlToDomParser }

{constructor / destructor}

constructor TXmlToDomParser.Create(AOwner: TComponent);
begin
  inherited;
  CreateSubcomponents;
  FBufferSize := 4096;
  KeepCDATASections := True;
  KeepComments := True;
  KeepEntityRefs := True;
end;

procedure TXmlToDomParser.CreateSubcomponents;
begin
  FDocReader := TXmlStandardDocReader.Create(Self);
  FWFTestHandler := TXmlWFTestHandler.Create(Self);
  FDocBuilder := TXmlDomBuilder.Create(Self);
  FDocBuilder.DocTypeDeclTreatment := dtCheckWellformedness;

  FDocReader.DOMImpl := FDOMImpl;

  FDocReader.NextHandler := FWFTestHandler;
  FWFTestHandler.NextHandler := FDocBuilder;
end;

{property methods}

function TXmlToDomParser.GetKeepCDATASections: Boolean;
begin
  Result := FDocBuilder.KeepCDATASections;
end;

function TXmlToDomParser.GetKeepComments: Boolean;
begin
  Result := FDocBuilder.KeepComments;
end;

function TXmlToDomParser.GetKeepEntityRefs: Boolean;
begin
  Result := FDocBuilder.KeepEntityRefs;
end;

procedure TXmlToDomParser.SetBufferSize(const Value: Integer);
begin
  if Value < 1024 then
    raise ENot_Supported_Err.Create('BufferSize must not be less than 1024.');
  FBufferSize := Value;
end;

procedure TXmlToDomParser.SetKeepCDATASections(const Value: Boolean);
begin
  FDocBuilder.KeepCDATASections := Value;
end;

procedure TXmlToDomParser.SetKeepComments(const Value: Boolean);
begin
  FDocBuilder.KeepComments := Value;
end;

procedure TXmlToDomParser.SetKeepEntityRefs(const Value: Boolean);
begin
  FDocBuilder.KeepEntityRefs := Value;
end;

procedure TXmlToDomParser.SetDomImpl(const Impl: TDomImplementation);
begin
  inherited;
  FDocReader.DOMImpl := Impl;
end;

{error reporting}

function TXmlToDomParser.SendErrorNotification(const XmlErrorType: TXmlErrorType): Boolean;
var
  Error: TDomError;
begin
  Error := TDomError.CreateFromLocator(XmlErrorType, nil, '', '');
  try
    if Assigned(DomImpl)
      then Result := DomImpl.HandleError(Self, Error)
      else Result := not (Error.Severity = DOM_SEVERITY_FATAL_ERROR);
  finally
    Error.Free;
  end;
end;

{parsing methods}

procedure TXmlToDomParser.ParseFragment(const InputSource: TXmlSimpleInputSource;
                                        const DocFrag: TDomDocumentFragment);
begin
  if not Assigned(DocFrag) then
    raise EAccessViolation.Create('Reference document fragment not specified.');
  if not Assigned(DOMImpl) then
    raise EAccessViolation.Create('DOM implementation not specified.');

  FDocBuilder.ReferenceNode := DocFrag;
  if not FDocReader.ParseFragment(InputSource) then
    raise EParserException.Create('Parser error.');
end;

function TXmlToDomParser.FileToDom(const Filename: TFileName): TDomDocument;
var
  SourceStream: TFileStream;
begin
  if Filename = '' then
    raise EAccessViolation.Create('Filename not specified.');
  SourceStream := TFileStream.Create(Filename, fmOpenRead);
  try
    Result := StreamToDom(SourceStream, FilenameToUriWideStr(Filename, []), nil, True);
  finally
    SourceStream.Free;
  end;
end;

function TXmlToDomParser.SourceCodeToDom(const DocSourceCode: TXmlSourceCode;
                                         const SysId: WideString): TDomDocument;
begin
  if not Assigned(DocSourceCode) then
    raise EAccessViolation.Create('Source code not specified.');
  Result := WideStringToDom(DocSourceCode.Text, SysId, TUTF16LECodec, True);
end;

function TXmlToDomParser.StreamToDom(const Stream: TStream;
                                     const SysId: WideString;
                                     const CodecClass: TUnicodeCodecClass;
                                     const InclDecl: Boolean): TDomDocument;
var
  InputSrc: TXmlInputSource;
begin
  if not Assigned(Stream) then
    raise EAccessViolation.Create('Stream not specified.');
  try
    InputSrc := TXmlInputSource.Create(Stream, '', SysId, FBufferSize, CodecClass,
                  InclDecl, 0, 0, 0, 0, 1); 
  except
    on ENot_Supported_Err do begin
      SendErrorNotification(ET_ENCODING_NOT_SUPPORTED);
      raise EParserException.Create('Parser error.');
    end;
    on EConvertError do begin
      SendErrorNotification(ET_BYTE_ORDER_MARK_ENCODING_MISMATCH);
      raise EParserException.Create('Parser error.');
    end;
  end;
  try
    Result := XmlInputSourceToDom(InputSrc);
  finally
    InputSrc.Free;
  end;
end;

function TXmlToDomParser.StringToDom(const S: string;
                                     const SysId: WideString;
                                     const CodecClass: TUnicodeCodecClass;
                                     const InclDecl: Boolean): TDomDocument;
var
  StrStream: TStringStream;
begin
  if S = '' then
    raise EAccessViolation.Create('Empty string.');
  StrStream := TStringStream.Create(S);
  try
    Result := StreamToDom(StrStream, SysId, CodecClass, InclDecl);
  finally
    StrStream.Free;
  end;
end;

function TXmlToDomParser.UriToDom(      Uri: WideString;
                                  const CodecClass: TUnicodeCodecClass;
                                  const InclDecl: Boolean): TDomDocument;
var
  Stream: TStream;
  PubId: WideString;
begin
  Stream := DOMImpl.ResolveResourceAsStream('', PubId, Uri); // Creates Stream.  Raises EAccessViolation if DOMImpl = nil.
  if Assigned(Stream) then begin
    try
      Result := StreamToDom(Stream, Uri, CodecClass, InclDecl);
    finally
      Stream.Free;
    end;
  end else
    Result := nil;
end;

function TXmlToDomParser.WideStringToDom(const S: WideString;
                                         const SysId: WideString;
                                         const CodecClass: TUnicodeCodecClass;
                                         const InclDecl: Boolean): TDomDocument;
var
  WStrStream: TUtilsWideStringStream;
begin
  if S = '' then
    raise EAccessViolation.Create('Empty string.');
  WStrStream := TUtilsWideStringStream.Create(S);
  try
    Result := StreamToDom(WStrStream, SysId, CodecClass, InclDecl);
  finally
    WStrStream.Free;
  end;
end;

function TXmlToDomParser.XmlInputSourceToDom(const InputSource: TXmlInputSource): TDomDocument;
var
  NewDoc: TDomDocument;
begin
  if not Assigned(InputSource) then
    raise EAccessViolation.Create('Input source not specified.');
  if not Assigned(DOMImpl) then
    raise EAccessViolation.Create('DOM implementation not specified.');

  if InputSource.HasMalformedDecl
   or not ( InputSource.DeclType in [ DT_XML_DECLARATION,
                                      DT_XML_OR_TEXT_DECLARATION,
                                      DT_UNSPECIFIED ] )
  then begin
    SendErrorNotification(ET_INVALID_XML_DECL);
    raise EParserException.Create('Parser error.');
  end;
  if InputSource.XmlVersion <> '1.0' then begin
    SendErrorNotification(ET_XML_VERSION_NOT_SUPPORTED);
    raise EParserException.Create('Parser error.');
  end;

  NewDoc := TDomDocument.Create(DOMImpl);
  try
    NewDoc.DocumentUri := InputSource.SystemId;
    FDocBuilder.ReferenceNode := NewDoc;
    if not FDocReader.Parse(InputSource) then
      raise EParserException.Create('Parser error.');
    Result := NewDoc;
  except
    NewDoc.Free;
    raise;
  end;
end;



{ TDtdToDtdModelParser }

constructor TDtdToDtdModelParser.Create(AOwner: TComponent);
begin
  inherited;
  CreateSubcomponents;
  FBufferSize := 4096;
  FTargetDtdModel := nil;
end;

procedure TDtdToDtdModelParser.CreateSubcomponents;
begin
  FDtdReader := TXmlStandardDtdReader.Create(Self);
  FDtdReader.DOMImpl:= DOMImpl;

  FWFTestHandler := TXmlWFTestHandler.Create(Self);
  FDtdModelBuilder := TXmlDtdModelBuilder.Create(Self);

  FDtdReader.NextHandler := FWFTestHandler;
  FWFTestHandler.NextHandler := FDtdModelBuilder;
end;

procedure TDtdToDtdModelParser.ExtSubsetSourceCodeToDtdModel(const ExtDtdSourceCode: TXmlSourceCode;
                                                             const PubId,
                                                                   SysId: WideString);
begin
  if not Assigned(ExtDtdSourceCode) then
    raise EAccessViolation.Create('Source code not specified.');
  ExtSubsetWideStringToDtdModel(ExtDtdSourceCode.Text, PubId, SysId, TUTF16LECodec, True);
end;

procedure TDtdToDtdModelParser.ExtSubsetStreamToDtdModel(const Stream: TStream;
                                                         const PubId,
                                                               SysId: WideString;
                                                         const CodecClass: TUnicodeCodecClass;
                                                         const InclDecl: Boolean);
var
  InputSrc: TXmlInputSource;
begin
  if not Assigned(Stream) then
    raise EAccessViolation.Create('Stream not specified.');
  FDtdModelBuilder.DtdModel := TargetDtdModel;
  try
    InputSrc := TXmlInputSource.Create(Stream, PubId, SysId, FBufferSize, CodecClass,
                  InclDecl, 0, 0, 0, 0, 1);  
  except
    on ENot_Supported_Err do begin
      SendErrorNotification(ET_ENCODING_NOT_SUPPORTED);
      raise EParserException.Create('Parser error.');
    end;
    on EConvertError do begin
      SendErrorNotification(ET_BYTE_ORDER_MARK_ENCODING_MISMATCH);
      raise EParserException.Create('Parser error.');
    end;
  end;
  try
    if not FDtdReader.ParseExternalSubset(InputSrc) then
      raise EParserException.Create('Parser error.');
  finally
    InputSrc.Free;
  end;
end;

procedure TDtdToDtdModelParser.ExtSubsetStringToDtdModel(const S: string;
                                                         const PubId,
                                                               SysId: WideString;
                                                         const CodecClass: TUnicodeCodecClass;
                                                         const InclDecl: Boolean);
var
  StrStream: TStringStream;
begin
  if S = '' then
    raise EAccessViolation.Create('Empty string.');
  StrStream := TStringStream.Create(S);
  try
    ExtSubsetStreamToDtdModel(StrStream, PubId, SysId, CodecClass, InclDecl);
  finally
    StrStream.Free;
  end;
end;

procedure TDtdToDtdModelParser.ExtSubsetWideStringToDtdModel(      S: WideString;
                                                             const PubId,
                                                                   SysId: WideString;
                                                             const CodecClass: TUnicodeCodecClass;
                                                             const InclDecl: Boolean);
var
  WStrStream: TUtilsWideStringStream;
begin
  if S = '' then
    raise EAccessViolation.Create('Empty string.');
  WStrStream := TUtilsWideStringStream.Create(S);
  try
    ExtSubsetStreamToDtdModel(WStrStream, PubId, SysId, CodecClass, InclDecl);
  finally
    WStrStream.Free;
  end;
end;

procedure TDtdToDtdModelParser.IntSubsetSourceCodeToDtdModel(const IntDtdSourceCode: TXmlSourceCode;
                                                             const PubId,
                                                                   SysId: WideString;
                                                             const Standalone: TDomStandalone;
                                                             const IntSubsetStartByteNumber,
                                                                   IntSubsetStartCharNumber,
                                                                   IntSubsetStartColumn,
                                                                   IntSubsetStartLine: Int64;
                                                             const ResolveExtPEs: Boolean);
begin
  if not Assigned(intDtdSourceCode) then
    raise EAccessViolation.Create('Source code not specified.');
  IntSubsetWideStringToDtdModel(IntDtdSourceCode.Text, PubId, SysId, TUTF16LECodec,
    Standalone, IntSubsetStartByteNumber, IntSubsetStartCharNumber,
    IntSubsetStartColumn, IntSubsetStartLine, ResolveExtPEs);
end;

procedure TDtdToDtdModelParser.IntSubsetStreamToDtdModel(const Stream: TStream;
                                                         const PubId,
                                                               SysId: WideString;
                                                         const CodecClass: TUnicodeCodecClass;
                                                         const Standalone: TDomStandalone;
                                                         const IntSubsetStartByteNumber,
                                                               IntSubsetStartCharNumber,
                                                               IntSubsetStartColumn,
                                                               IntSubsetStartLine: Int64;
                                                         const ResolveExtPEs: Boolean);
var
  InputSrc: TXmlSimpleInputSource;
begin
  if not Assigned(Stream) then
    raise EAccessViolation.Create('Stream not specified.');
  FDtdModelBuilder.DtdModel := TargetDtdModel;
  try
    InputSrc := TXmlSimpleInputSource.Create(Stream, PubId, SysId, FBufferSize,
                  CodecClass, IntSubsetStartByteNumber, IntSubsetStartCharNumber,
                  IntSubsetStartColumn, 0, IntSubsetStartLine);
  except
    on ENot_Supported_Err do begin
      SendErrorNotification(ET_ENCODING_NOT_SUPPORTED);
      raise EParserException.Create('Parser error.');
    end;
    on EConvertError do begin
      SendErrorNotification(ET_BYTE_ORDER_MARK_ENCODING_MISMATCH);
      raise EParserException.Create('Parser error.');
    end;
  end;
  try
    if not FDtdReader.ParseInternalSubset(InputSrc, Standalone, ResolveExtPEs) then
      raise EParserException.Create('Parser error.');
  finally
    InputSrc.Free;
  end;
end;

procedure TDtdToDtdModelParser.IntSubsetStringToDtdModel(const S: string;
                                                         const PubId,
                                                               SysId: WideString;
                                                         const CodecClass: TUnicodeCodecClass;
                                                         const Standalone: TDomStandalone;
                                                         const IntSubsetStartByteNumber,
                                                               IntSubsetStartCharNumber,
                                                               IntSubsetStartColumn,
                                                               IntSubsetStartLine: Int64;
                                                         const ResolveExtPEs: Boolean);
var
  StrStream: TStringStream;
begin
  if S = '' then
    raise EAccessViolation.Create('Empty string.');
  StrStream := TStringStream.Create(S);
  try
    IntSubsetStreamToDtdModel(StrStream, PubId, SysId, CodecClass, Standalone,
      IntSubsetStartByteNumber, IntSubsetStartCharNumber, IntSubsetStartColumn,
      IntSubsetStartLine, ResolveExtPEs);
  finally
    StrStream.Free;
  end;
end;

procedure TDtdToDtdModelParser.IntSubsetWideStringToDtdModel(      S: WideString;
                                                             const PubId,
                                                                   SysId: WideString;
                                                             const CodecClass: TUnicodeCodecClass;
                                                             const Standalone: TDomStandalone;
                                                             const IntSubsetStartByteNumber,
                                                                   IntSubsetStartCharNumber,
                                                                   IntSubsetStartColumn,
                                                                   IntSubsetStartLine: Int64;
                                                             const ResolveExtPEs: Boolean);
var
  WStrStream: TUtilsWideStringStream;
begin
  if S = '' then
    raise EAccessViolation.Create('Empty string.');
  WStrStream := TUtilsWideStringStream.Create(S);
  try
    IntSubsetStreamToDtdModel(WStrStream, PubId, SysId, CodecClass, Standalone,
      IntSubsetStartByteNumber, IntSubsetStartCharNumber, IntSubsetStartColumn,
      IntSubsetStartLine, ResolveExtPEs);    
  finally
    WStrStream.Free;
  end;
end;

procedure TDtdToDtdModelParser.ParseDocTypeDecl(const DocTypeDecl: TDomDocumentTypeDecl;
                                                const ResolveExtEntities: Boolean);
var
  DocUri: WideString;
  ExtDtdStream: TStream;
  PubId, SysId, SysUri: WideString;
  Standalone: TDomStandalone;
begin
  if not Assigned(DocTypeDecl) then
    raise EAccessViolation.Create('Document type declaration not specified.');
  if not Assigned(DOMImpl) then
    raise EAccessViolation.Create('DOM implementation not specified.');
  if not Assigned(TargetDtdModel) then
    raise EAccessViolation.Create('Target DTD model not specified.');

  if Assigned(DocTypeDecl.RootDocument) then begin
    if not (DocTypeDecl.RootDocument.DomImplementation = DOMImpl) then
      raise EWrong_DOM_Implementation_Err.Create('Wrong DOM implementation error.');
    DocUri := DocTypeDecl.RootDocument.DocumentUri;
  end else
    raise EWrong_DOM_Implementation_Err.Create('Wrong DOM implementation error.');

  Prepare;

  if Assigned(DocTypeDecl.OwnerDocument)
    then Standalone := DocTypeDecl.OwnerDocument.XmlStandalone
    else Standalone := STANDALONE_UNSPECIFIED;

  try

    // Parse the internal subset of the DTD, if any:
    if DocTypeDecl.InternalSubset = '' then begin
      TargetDtdModel.PreparationStatus := PS_INEXISTANT;
    end else begin
      IntSubsetWideStringToDtdModel(DocTypeDecl.InternalSubset,
                                    '',
                                    DocUri,
                                    TUTF16LECodec,
                                    Standalone,
                                    DocTypeDecl.IntSubsetStartByteNumber,
                                    DocTypeDecl.IntSubsetStartCharNumber,
                                    DocTypeDecl.IntSubsetStartColumn,
                                    DocTypeDecl.IntSubsetStartLine,
                                    ResolveExtEntities);
    end;

    if TargetDtdModel.PreparationStatus in [ PS_INT_SUBSET_COMPLETED, PS_INEXISTANT ] then begin
      // Parse the external subset of the DTD, if any:
      PubId := DocTypeDecl.PublicId;
      SysId := DocTypeDecl.SystemId;
      if (PubId <> '') or (SysId <> '') then begin
        if ResolveExtEntities then begin
          ExtDtdStream := DOMImpl.ResolveResourceAsStream(DocUri, PubId, SysId);
          if Assigned(ExtDtdStream) then begin
            try
              ResolveRelativeUriWideStr(DocUri, SysId, SysUri);
                  // Remark: Returns an empty SysUri if ResolveRelativeUriWideStr attempt fails.
              ExtSubsetStreamToDtdModel(ExtDtdStream, PubId, SysUri, nil, False);
            finally
              ExtDtdStream.Free;
            end; {try ... finally ...}
          end else begin
            SendErrorNotification(ET_UNRESOLVABLE_EXTERNAL_SUBSET);
            TargetDtdModel.PreparationStatus := PS_INCOMPLETE_ABORTED;
          end; {if ...}
        end else
        if TargetDtdModel.PreparationStatus = PS_INT_SUBSET_COMPLETED then
          TargetDtdModel.PreparationStatus := PS_INCOMPLETE_STANDALONE;
      end else
        if TargetDtdModel.PreparationStatus = PS_INT_SUBSET_COMPLETED then
          TargetDtdModel.PreparationStatus := PS_COMPLETED;
    end;
    
  except
    TargetDtdModel.PreparationStatus := PS_INCOMPLETE_ABORTED;
  end;
end;

procedure TDtdToDtdModelParser.Prepare;
begin
  FDtdReader.Prepare;
  if Assigned(TargetDtdModel) then
    TargetDtdModel.Clear;
end;

function TDtdToDtdModelParser.SendErrorNotification(const XmlErrorType: TXmlErrorType): Boolean;
var
  Error: TDomError;
begin
  Error := TDomError.CreateFromLocator(XmlErrorType, nil, '', '');
  try
    if Assigned(DomImpl) then begin
      Result := DomImpl.HandleError(Self, Error);
    end else if Error.Severity = DOM_SEVERITY_FATAL_ERROR
      then Result := False
      else Result := True;
  finally
    Error.Free;
  end;
end;

procedure TDtdToDtdModelParser.SetBufferSize(const Value: Integer);
begin
  if Value < 1024
    then raise ENot_Supported_Err.Create('BufferSize must not be less than 1024.');
  FBufferSize := Value;
end;

procedure TDtdToDtdModelParser.SetDomImpl(const ADOMImpl: TDomImplementation);
begin
  inherited;
  FDtdReader.DOMImpl:= ADOMImpl;
end;

procedure TDtdToDtdModelParser.SetTargetDtdModel(const Value: TDtdModel);
begin
  FTargetDtdModel := Value;
end;



{ TDomToXmlParser }

constructor TDomToXmlParser.Create(AOwner: TComponent);
begin
  inherited;

  FDomReader := TXmlStandardDomReader.Create(Self);
  FStreamBuilder := TXmlStreamBuilder.Create(Self);
  FStreamBuilder.IncludeXmlDecl  := True;
  FWFTestHandler := TXmlWFTestHandler.Create(Self);
  FWFTestHandler.NextHandler := FStreamBuilder;
  FDomReader.NextHandler := FStreamBuilder;
  FDomReader.IgnoreUnspecified := True;

  FBufferSize := 4096;
  FUseActiveCodePage := False;
  FWriteLFOption := lwCRLF;
end;

function TDomToXmlParser.GetIgnoreUnspecified: Boolean;
begin
  Result := DomReader.IgnoreUnspecified;
end;

function TDomToXmlParser.GetIncludeXmlDecl: Boolean;
begin
  Result := StreamBuilder.IncludeXmlDecl;
end;

function TDomToXmlParser.GetOnAfterWrite: TDomSerializationEvent;
begin
  Result := StreamBuilder.OnAfterWrite;
end;

function TDomToXmlParser.GetOnBeforeWrite: TDomSerializationEvent;
begin
  Result := StreamBuilder.OnBeforeWrite;
end;

function TDomToXmlParser.GetStrictErrorChecking: Boolean;
begin
  Result := (DomReader.NextHandler = FWFTestHandler);
end;

function TDomToXmlParser.GetUseByteOrderMark: TXmlBOMOpt;
begin
  Result := StreamBuilder.UseByteOrderMark;
end;

procedure TDomToXmlParser.SetBufferSize(const Value: Integer);
begin
  if Value < 1024 then
    raise ENot_Supported_Err.Create('BufferSize must not be less than 1024.');
  FBufferSize := Value;
end;

procedure TDomToXmlParser.SetIgnoreUnspecified(const Value: Boolean);
begin
  DomReader.IgnoreUnspecified := Value;
end;

procedure TDomToXmlParser.SetIncludeXmlDecl(const Value: Boolean);
begin
  StreamBuilder.IncludeXmlDecl := Value;
end;

procedure TDomToXmlParser.SetOnAfterWrite(const Value: TDomSerializationEvent);
begin
  StreamBuilder.OnAfterWrite := Value;
end;

procedure TDomToXmlParser.SetOnBeforeWrite(const Value: TDomSerializationEvent);
begin
  StreamBuilder.OnBeforeWrite := Value;
end;

procedure TDomToXmlParser.SetStrictErrorChecking(const Value: Boolean);
begin
  if Value
    then DomReader.NextHandler := WFTestHandler
    else DomReader.NextHandler := StreamBuilder;
end;

{$IFNDEF LINUX}
procedure TDomToXmlParser.SetUseActiveCodePage(const Value: Boolean);
begin
  FUseActiveCodePage := Value;
end;
{$ENDIF}

procedure TDomToXmlParser.SetUseByteOrderMark(const Value: TXmlBOMOpt);
begin
  StreamBuilder.UseByteOrderMark := Value;
end;

procedure TDomToXmlParser.SetWriteLFOption(const Value: TCodecWriteLFOption);
begin
  FWriteLFOption := Value;
end;

function TDomToXmlParser.WriteToStream(const WNode: TDomNode;
                                       const Encoding: WideString; 
                                       const Destination: TStream): Boolean;
var
  OutputSource: TXmlOutputSource;
begin
  if not Assigned(DOMImpl) then
    raise EAccessViolation.Create('DOMImplementation not specified.');
  if not Assigned(Destination) then
    raise EAccessViolation.Create('Destination stream not specified.');
  if not Assigned(WNode) then
    raise EAccessViolation.Create('Source node not specified.');

  DomReader.DOMImpl := DOMImpl;
{$IFDEF LINUX}
  StreamBuilder.DefaultEncoding := Encoding;  // Raises an ENot_Supported_Err, if the specified encoding is not supported
{$ELSE}
  if UseActiveCodePage
    then StreamBuilder.DefaultEncoding := GetSystemEncodingName
    else StreamBuilder.DefaultEncoding := Encoding;  // Raises an ENot_Supported_Err, if the specified encoding is not supported
{$ENDIF}
  OutputSource := TXmlOutputSource.Create(Destination, FBufferSize);
  try
    OutputSource.WriteLFOption := WriteLFOption;
    StreamBuilder.OutputSource := OutputSource;
    Result := DomReader.Parse(WNode);
  finally
    StreamBuilder.OutputSource := nil;
    OutputSource.Free;
  end;
end;

function TDomToXmlParser.WriteToString(const WNode: TDomNode;
                                             Encoding: WideString;
                                         out S: string): Boolean;
var
  XmlStream: TStringStream;
begin
  XmlStream := TStringStream.Create('');
  try
    Result := WriteToStream(WNode, Encoding, XmlStream);
    S := XmlStream.DataString;
  finally
    XmlStream.Free;
  end;
end;

function TDomToXmlParser.WriteToWideString(const WNode: TDomNode;
                                             out S: WideString): Boolean;
var
  XmlStream: TUtilsWideStringStream;
begin
  XmlStream := TUtilsWideStringStream.Create('');
  try
    Result := WriteToStream(WNode, 'UTF-16LE', XmlStream);
    S := XmlStream.DataString;
  finally
    XmlStream.Free;
  end;
end;



{XPath Function Library -- see XPath 1.0, sec. 4}

{XPath Node set Functions -- see XPath 1.0, sec. 4.1.}

function XPathFunctionLast(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;
begin
  if Arguments.Count > 0 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['last']);
  if ContextSize < 1 then
    raise EXPath_Invalid_Function_Call_Err.Create('Invalid context size.');
  Result := TDomXPathNumberResult.Create(ContextSize);
end;

function XPathFunctionPosition(const ContextNode: TDomNode;
                               const ContextPosition: Integer;
                               const ContextSize: Integer;
                               const Arguments: TList): TDomXPathCustomResult;
begin
  if Arguments.Count > 0 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['position']);
  if ContextPosition < 1 then
    raise EXPath_Invalid_Function_Call_Err.Create('Invalid context position.');
  Result := TDomXPathNumberResult.Create(ContextPosition);
end;

function XPathFunctionCount(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['count']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNodeSetResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to node-set.',['count']);
    Result := TDomXPathNumberResult.Create(TDomXPathNodeSetResult(ExprResult).Length);
  finally
    ExprResult.Free;
  end;
end;

function XPathFunctionId(const ContextNode: TDomNode;
                         const ContextPosition: Integer;
                         const ContextSize: Integer;
                         const Arguments: TList): TDomXPathCustomResult;
var
  Doc: TDomDocumentNS;
  ExprResult: TDomXPathCustomResult;
  I: Integer;
  IdList: TUtilsWideStringList;
  IdNode: TDomNode;

  procedure AddId(const IdList: TUtilsWideStringList;
                  const S: WideString);
  const
    NULL: WideChar = #0; // end of WideString mark
  var
    Head, Tail: PWideChar;
    idString: WideString;
  begin
    // Skip white space:
    Head := PWideChar(S);
    while IsXmlWhiteSpace(Head^) do
      Inc(Head);

    while Head^ <> NULL do begin
      // Determine next ID:
      Tail := Head;
      while not isXmlWhiteSpaceOrNull(Tail^) do
        Inc(Tail);
      SetString(idString, Head, Tail - Head);
      IdList.Add(idString);

      // Skip white space:
      Head := Tail;
      while IsXmlWhiteSpace(Head^) do
        Inc(Head);
    end;
  end;

begin
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['id']);
  if not Assigned(ContextNode) then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Context node not specified for %s().',['id']);
  if not Assigned(ContextNode.OwnerDocument) then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Context node with no owner document specified for %s().',['id']);
  IdList := nil; // Remark: This saves one try ... finally block.
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try

    // Determine ID list:
    IdList:= TUtilsWideStringList.Create;
    with IdList do begin
      Duplicates := dupIgnore;
      Sorted := True;
    end;
    if ExprResult is TDomXPathNodeSetResult then begin
      for I := 0 to Pred(TDomXPathNodeSetResult(ExprResult).Length) do
        AddId(IdList, TDomXPathNodeSetResult(ExprResult).Item(I).XPathStringValue);
    end else
      AddId(IdList, ExprResult.AsWideString);

    // Find ID nodes:
    Result := TDomXPathNodeSetResult.Create;
    try
      Doc := ContextNode.OwnerDocument as TDomDocumentNS;
      for I := 0 to Pred(IdList.Count) do begin
        IdNode := Doc.GetElementById(IdList[I]);
        if Assigned(IdNode) then
          TDomXPathNodeSetResult(Result).Add(IdNode);
      end;
      TDomXPathNodeSetResult(Result).Sort;
    except
      Result.Free;
      raise;
    end;

  finally
    IdList.Free;
    ExprResult.Free;
  end;
end;

function XPathFunctionLocalName(const ContextNode: TDomNode;
                                const ContextPosition: Integer;
                                const ContextSize: Integer;
                                const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count > 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['local-name']);
  if Arguments.Count = 0 then begin
    ExprResult := TDomXPathNodeSetResult.Create;
    TDomXPathNodeSetResult(ExprResult).Add(ContextNode);
  end else
    ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNodeSetResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to node-set.',['local-name']);
    with ExprResult do begin
      AxisType := XPATH_FORWARD_AXIS;
      if Length = 0 then begin
        Result := TDomXPathStringResult.Create('');
      end else begin
        if Item(0) is TDomProcessingInstruction
          then Result := TDomXPathStringResult.Create(TDomProcessingInstruction(Item(0)).Target)
          else Result := TDomXPathStringResult.Create(TDomNode(Item(0)).LocalName);
      end;
    end;
  finally
    ExprResult.Free;
  end;
end;

function XPathFunctionNamespaceUri(const ContextNode: TDomNode;
                                   const ContextPosition: Integer;
                                   const ContextSize: Integer;
                                   const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count > 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['namespace-uri']);
  if Arguments.Count = 0 then begin
    ExprResult := TDomXPathNodeSetResult.Create;
    TDomXPathNodeSetResult(ExprResult).Add(ContextNode);
  end else
    ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNodeSetResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to node-set.',['namespace-uri']);
    with ExprResult do begin
      AxisType := XPATH_FORWARD_AXIS;
      if Length = 0
        then Result := TDomXPathStringResult.Create('')
        else Result := TDomXPathStringResult.Create(TDomNode(Item(0)).NamespaceUri);
    end;
  finally
    ExprResult.Free;
  end;
end;

function XPathFunctionName(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count > 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['name']);
  if Arguments.Count = 0 then begin
    ExprResult := TDomXPathNodeSetResult.Create;
    TDomXPathNodeSetResult(ExprResult).Add(ContextNode);
  end else
    ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNodeSetResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to node-set.',['name']);
    with ExprResult do begin
      AxisType := XPATH_FORWARD_AXIS;
      if Length = 0
        then Result := TDomXPathStringResult.Create('')
        else Result := TDomXPathStringResult.Create(TDomNode(Item(0)).ExpandedName);
    end;
  finally
    ExprResult.Free;
  end;
end;

{XPath String Functions -- see XPath 1.0, sec. 4.2.}

function XPathFunctionString(const ContextNode: TDomNode;
                             const ContextPosition: Integer;
                             const ContextSize: Integer;
                             const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  if Arguments.Count > 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['string']);
  if Arguments.Count = 0 then begin
    ExprResult := TDomXPathNodeSetResult.Create;
    TDomXPathNodeSetResult(ExprResult).Add(ContextNode);
  end else
    ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  Result := XPathStringFunc(ExprResult);  // As a side-effect automatically frees ExprResult.
end;

function XPathFunctionConcat(const ContextNode: TDomNode;
                             const ContextPosition: Integer;
                             const ContextSize: Integer;
                             const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
  I: Integer;
  S: WideString;
begin
  if Arguments.Count < 2 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['concat']);
  S := '';
  for I := 0 to Pred(Arguments.Count) do begin
    ExprResult := TDomXPathExpr(Arguments[I]).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      if not (ExprResult is TDomXPathStringResult) then
        raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['concat']);
      S := Concat(S, ExprResult.AsWideString);
    finally
      ExprResult.Free;
    end;
  end;
  Result := TDomXPathStringResult.Create(S);
end;

function XPathFunctionStartsWith(const ContextNode: TDomNode;
                                 const ContextPosition: Integer;
                                 const ContextSize: Integer;
                                 const Arguments: TList): TDomXPathCustomResult;
var
  S1_Result, S2_Result: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 2 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['starts-with']);
  S2_Result := nil; // Remark: Saves one try ... finally block
  S1_Result := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    S2_Result := TDomXPathExpr(Arguments[1]).Evaluate(ContextNode, ContextPosition, ContextSize);
    if not ( (S1_Result is TDomXPathStringResult) and (S2_Result is TDomXPathStringResult) ) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['starts-with']);
    Result := TDomXPathBooleanResult.Create(
                CompareWideStr(
                  Copy(S1_Result.AsWideString, 1, Length(S2_Result.AsWideString)),
                  S2_Result.AsWideString
                ) = 0
              );
  finally
    S1_Result.Free;
    S2_Result.Free;
  end;
end;

function XPathFunctionContains(const ContextNode: TDomNode;
                               const ContextPosition: Integer;
                               const ContextSize: Integer;
                               const Arguments: TList): TDomXPathCustomResult;
var
  S1_Result, S2_Result: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 2 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['contains']);
  S2_Result := nil; // Remark: Saves one try ... finally block
  S1_Result := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    S2_Result := TDomXPathExpr(Arguments[1]).Evaluate(ContextNode, ContextPosition, ContextSize);
    if not ( (S1_Result is TDomXPathStringResult) and (S2_Result is TDomXPathStringResult) ) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['contains']);
    if Length(S2_Result.AsWideString) = 0
      then Result := TDomXPathBooleanResult.Create(True)
      else Result := TDomXPathBooleanResult.Create(
                       Pos(S2_Result.AsWideString,S1_Result.AsWideString) > 0
                     );
  finally
    S1_Result.Free;
    S2_Result.Free;
  end;
end;

function XPathFunctionSubstringBefore(const ContextNode: TDomNode;
                                      const ContextPosition: Integer;
                                      const ContextSize: Integer;
                                      const Arguments: TList): TDomXPathCustomResult;
var
  S1_Result, S2_Result: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 2 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['substring-before']);
  S2_Result := nil; // Remark: Saves one try ... finally block
  S1_Result := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    S2_Result := TDomXPathExpr(Arguments[1]).Evaluate(ContextNode, ContextPosition, ContextSize);
    if not ( (S1_Result is TDomXPathStringResult) and (S2_Result is TDomXPathStringResult) ) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['substring-before']);
    Result := TDomXPathStringResult.Create(
                Copy(S1_Result.AsWideString, 1,
                       Pred( Pos(S2_Result.AsWideString, S1_Result.AsWideString ) ) )
              );
  finally
    S1_Result.Free;
    S2_Result.Free;
  end;
end;

function XPathFunctionSubstringAfter(const ContextNode: TDomNode;
                                     const ContextPosition: Integer;
                                     const ContextSize: Integer;
                                     const Arguments: TList): TDomXPathCustomResult;
var
  S1_Result, S2_Result: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 2 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['substring-after']);
  S2_Result := nil; // Remark: Saves one try ... finally block
  S1_Result := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    S2_Result := TDomXPathExpr(Arguments[1]).Evaluate(ContextNode, ContextPosition, ContextSize);
    if not ( (S1_Result is TDomXPathStringResult) and (S2_Result is TDomXPathStringResult) ) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['substring-after']);
    if Length(S2_Result.AsWideString) = 0
      then Result := TDomXPathStringResult.Create(S1_Result.AsWideString)
      else Result := TDomXPathStringResult.Create(
                       Copy(S1_Result.AsWideString,
                            Pos(S2_Result.AsWideString, S1_Result.AsWideString )
                              + Length(S2_Result.AsWideString),
                            Length(S1_Result.AsWideString)
                           )
                     );
  finally
    S1_Result.Free;
    S2_Result.Free;
  end;
end;

function XPathFunctionSubstring(const ContextNode: TDomNode;
                                const ContextPosition: Integer;
                                const ContextSize: Integer;
                                const Arguments: TList): TDomXPathCustomResult;
var
  S1_Result, N1_Result, N2_Result: TDomXPathCustomResult;
  I, L: Integer;
begin
  Result := nil;
  if (Arguments.Count <> 2) and (Arguments.Count <> 3) then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['substring']);
  N1_Result := nil; // Remark: Saves one try ... finally block
  N2_Result := nil; // Remark: Saves one try ... finally block
  S1_Result := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    N1_Result := TDomXPathExpr(Arguments[1]).Evaluate(ContextNode, ContextPosition, ContextSize);
    if not (S1_Result is TDomXPathStringResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['substring']);
    if not (N1_Result is TDomXPathNumberResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to number.',['substring']);
    if Arguments.Count = 3 then begin
      N2_Result := TDomXPathExpr(Arguments[2]).Evaluate(ContextNode, ContextPosition, ContextSize);
      if not (N2_Result is TDomXPathNumberResult) then
        raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to number.',['substring']);

      if IsNaN(N1_Result.AsNumber) or
         IsInfinite(N1_Result.AsNumber) or
         IsNaN(N2_Result.AsNumber)
      then begin
        Result := TDomXPathStringResult.Create('');
      end else if IsInfinite(N2_Result.AsNumber) then begin
        if Sign(N2_Result.AsNumber) = 1
          then Result := TDomXPathStringResult.Create(Copy( S1_Result.AsWideString,
                                                            Trunc(XPathRound(N1_Result.AsNumber)),
                                                            Length(S1_Result.AsWideString) ))
          else Result := TDomXPathStringResult.Create('');
      end else begin
        I := Max(Trunc(XPathRound((N1_Result.AsNumber))), 1);
        L := Trunc(XPathRound((N1_Result.AsNumber)) + XPathRound((N2_Result.AsNumber))) - I;
        Result := TDomXPathStringResult.Create(Copy(S1_Result.AsWideString, I, L) );
      end;

    end else begin

      if IsNaN(N1_Result.AsNumber) then begin
        Result := TDomXPathStringResult.Create('');
      end else if IsInfinite(N1_Result.AsNumber) then begin
        if Sign(N1_Result.AsNumber) = 1
          then Result := TDomXPathStringResult.Create('')
          else Result := TDomXPathStringResult.Create(S1_Result.AsWideString);
      end else
        Result := TDomXPathStringResult.Create(Copy( S1_Result.AsWideString,
                                                     Trunc(XPathRound(N1_Result.AsNumber)),
                                                     Length(S1_Result.AsWideString) ));

    end;
  finally
    S1_Result.Free;
    N1_Result.Free;
    N2_Result.Free;
  end;
end;

function XPathFunctionStringLength(const ContextNode: TDomNode;
                                   const ContextPosition: Integer;
                                   const ContextSize: Integer;
                                   const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count > 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['string-length']);
  if Arguments.Count = 0 then begin
    if not Assigned(ContextNode) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Context node not specified for %s().',['string-length']);
    Result := TDomXPathNumberResult.Create(Length(ContextNode.XPathStringValue));
  end else begin
    ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      if not (ExprResult is TDomXPathStringResult) then
        raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['string-length']);
      Result := TDomXPathNumberResult.Create(Length(ExprResult.AsWideString));
    finally
      ExprResult.Free;
    end;
  end;
end;

function XPathFunctionNormalizeSpace(const ContextNode: TDomNode;
                                     const ContextPosition: Integer;
                                     const ContextSize: Integer;
                                     const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count > 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['normalize-space']);
  if Arguments.Count = 0 then begin
    if not Assigned(ContextNode) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Context node not specified for %s().',['normalize-space']);
    Result := TDomXPathStringResult.Create(NormalizeWhiteSpace(ContextNode.XPathStringValue));
  end else begin
    ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      if not (ExprResult is TDomXPathStringResult) then
        raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['normalize-space']);
      Result := TDomXPathStringResult.Create(NormalizeWhiteSpace(ExprResult.AsWideString));
    finally
      ExprResult.Free;
    end;
  end;
end;

function XPathFunctionTranslate(const ContextNode: TDomNode;
                                const ContextPosition: Integer;
                                const ContextSize: Integer;
                                const Arguments: TList): TDomXPathCustomResult;
var
  S1, S2, S3: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 3 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['translate']);
  S2 := nil; // Remark: Saves one try ... finally block
  S3 := nil; // Remark: Saves one try ... finally block
  S1 := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    S2 := TDomXPathExpr(Arguments[1]).Evaluate(ContextNode, ContextPosition, ContextSize);
    S3 := TDomXPathExpr(Arguments[2]).Evaluate(ContextNode, ContextPosition, ContextSize);
    if not ( (S1 is TDomXPathStringResult) and (S2 is TDomXPathStringResult) and (S3 is TDomXPathStringResult) ) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['translate']);
    Result := TDomXPathStringResult.Create(
                translateWideString(S1.AsWideString, S2.AsWideString, S3.AsWideString) );
  finally
    S1.Free;
    S2.Free;
    S3.Free;
  end;
end;

{XPath Boolean Functions -- see XPath 1.0, sec. 4.3.}

function XPathFunctionBoolean(const ContextNode: TDomNode;
                              const ContextPosition: Integer;
                              const ContextSize: Integer;
                              const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['boolean']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  Result := XPathBooleanFunc(ExprResult);  // As a side-effect automatically frees ExprResult.
end;

function XPathFunctionNot(const ContextNode: TDomNode;
                          const ContextPosition: Integer;
                          const ContextSize: Integer;
                          const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['not']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathBooleanResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to boolean.',['not']);
    Result := TDomXPathBooleanResult.Create(not(ExprResult.AsBoolean));
  finally
    ExprResult.Free;
  end;
end;

function XPathFunctionTrue(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;
begin
  if Arguments.Count > 0 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['true']);
  Result := TDomXPathBooleanResult.Create(True);
end;

function XPathFunctionFalse(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;
begin
  if Arguments.Count > 0 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['false']);
  Result := TDomXPathBooleanResult.Create(False);
end;

function XPathFunctionLang(const ContextNode: TDomNode;
                           const ContextPosition: Integer;
                           const ContextSize: Integer;
                           const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['lang']);
  if not Assigned(ContextNode) then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Context node not specified for %s().',['lang']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathStringResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to string.',['lang']);
    Result := TDomXPathBooleanResult.Create(
                isSubLanguage(ExprResult.AsWideString, ContextNode.language)
              );
  finally
    ExprResult.Free;
  end;
end;

{ XPath Number Functions -- see XPath 1.0, sec. 4.4. }

function XPathFunctionNumber(const ContextNode: TDomNode;
                             const ContextPosition: Integer;
                             const ContextSize: Integer;
                             const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  if Arguments.Count > 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['number']);
  if Arguments.Count = 0 then begin
    ExprResult := TDomXPathNodeSetResult.Create;
    TDomXPathNodeSetResult(ExprResult).Add(ContextNode);
  end else
    ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  Result := XPathNumberFunc(ExprResult);  // As a side-effect automatically frees ExprResult.
end;

function XPathFunctionSum(const ContextNode: TDomNode;
                          const ContextPosition: Integer;
                          const ContextSize: Integer;
                          const Arguments: TList): TDomXPathCustomResult;
var
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
  ExprResult: TDomXPathCustomResult;
  I: Integer;
  M, N: Double;
begin
  Result := nil;
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['sum']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNodeSetResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to node-set.',['sum']);
    N := 0;
{$IFDEF VER140+}
    ExceptionMaskBackup := SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
    try
      with TDomXPathNodeSetResult(ExprResult) do
        for I := 0 to Pred(Length) do begin
          try
            M := XPathWideStringToNumber(Item(I).XPathStringValue);
          except
            M := NaN;
          end;
          N := N + M;
        end;
{$IFDEF VER140+}
    finally
      SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
    except
      N := NaN;
{$ENDIF}
    end;
    Result := TDomXPathNumberResult.Create(N);
  finally
    ExprResult.Free;
  end;
end;

function XPathFunctionFloor(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['floor']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNumberResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to a number.',['floor']);
    with ExprResult do
      if IsNaN(AsNumber) or IsInfinite(AsNumber)
        then Result := TDomXPathNumberResult.Create(AsNumber)
        else Result := TDomXPathNumberResult.Create(Floor(AsNumber));
  finally
    ExprResult.Free;
  end;
end;

function XPathFunctionCeiling(const ContextNode: TDomNode;
                              const ContextPosition: Integer;
                              const ContextSize: Integer;
                              const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['ceiling']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNumberResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to a number.',['ceiling']);
    with ExprResult do
      if IsNaN(AsNumber) or IsInfinite(AsNumber)
        then Result := TDomXPathNumberResult.Create(AsNumber)
        else Result := TDomXPathNumberResult.Create(Ceil(AsNumber));
  finally
    ExprResult.Free;
  end;
end;

function XPathFunctionRound(const ContextNode: TDomNode;
                            const ContextPosition: Integer;
                            const ContextSize: Integer;
                            const Arguments: TList): TDomXPathCustomResult;
var
  ExprResult: TDomXPathCustomResult;
begin
  Result := nil;
  if Arguments.Count <> 1 then
    raise EXPath_Invalid_Function_Call_Err.CreateFmt('Arguments mismatch error in %s().',['round']);
  ExprResult := TDomXPathExpr(Arguments[0]).Evaluate(ContextNode, ContextPosition, ContextSize);
  try
    if not (ExprResult is TDomXPathNumberResult) then
      raise EXPath_Invalid_Function_Call_Err.CreateFmt('Argument mismatch error in %s(): Expression does not evaluate to a number.',['round']);
    Result := TDomXPathNumberResult.Create(XPathRound(ExprResult.AsNumber));
  finally
    ExprResult.Free;
  end;
end;

{ TDomXPathTokenizer }

constructor TDomXPathTokenizer.Create(const Expression: WideString;
                                      const XPathVersion: WideString);
begin
  if xpathVersion <> '1.0'
    then raise ENot_Supported_Err.CreateFmt('XPath version "%S" not supproted.',[xpathVersion]);
  FExpression := Expression;
  FLastSymbol := XPATH_INVALID_TOKEN;  // Use XPATH_INVALID_TOKEN as a dummy value
  FPosition:= 0;
  FDoubleSlashStatus:= SL_NO_DOUBLE_SLASH;
  FPositionCache:= 0;
  FSymbolCache:= XPATH_INVALID_TOKEN;
  FValueCache:= '';
  FCacheIsActive:= False;
end;

function TDomXPathTokenizer.DoubleColonFollows: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := FPosition+1 to Pred(Length(FExpression)) do begin
    if FExpression[I] = #$3a then begin
      if FExpression[I+1] = #$3a
        then Result := True;
      Exit;
    end;
    if not isXmlWhiteSpace(FExpression[I]) then Exit;
  end;
end;

function TDomXPathTokenizer.GetNextWideChar(out S: WideChar): Boolean;
begin
  if FPosition = Length(FExpression) then begin
    S := #0;
    Result := False;
  end else begin
    Inc(FPosition);
    S := FExpression[FPosition];
    Result := True;
  end;
end;

function TDomXPathTokenizer.IsFollowing(const Symbol: TDomXPathTokenType): Boolean;
begin
  if not FCacheIsActive then begin
    Read(FSymbolCache,FValueCache,FPositionCache);
    FCacheIsActive:= True;
  end;
  if FSymbolCache = Symbol
    then Result := True
    else Result := False;
end;

function TDomXPathTokenizer.LeftParanthesisFollows: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := FPosition+1 to Length(FExpression) do begin
    if FExpression[I] = #$28 then begin
      Result := True;
      Exit;
    end;
    if not isXmlWhiteSpace(FExpression[I]) then Exit;
  end;
end;

function TDomXPathTokenizer.LookAheadNextWideChar(out S: WideChar): Boolean;
begin
  if FPosition = Length(FExpression) then begin
    S := #0;
    Result := False;
  end else begin
    S := FExpression[FPosition+1];
    Result := True;
  end;
end;

procedure TDomXPathTokenizer.Read(out Symbol: TDomXPathTokenType;
                                  out Value: WideString;
                                  out Position: Integer);
var
  S: WideChar;
  L: WideChar;
  DecimalPointFound: Boolean;
begin
  if FCacheIsActive then begin
    Symbol := FSymbolCache;
    Value := FValueCache;
    Position := FPositionCache;
    FCacheIsActive:= False;
    Exit;
  end;
  case FDoubleSlashStatus of
    SL_NO_DOUBLE_SLASH: begin
      repeat
        if not GetNextWideChar(S) then begin
          // End of text:
          Symbol := XPATH_END_OF_TEXT_TOKEN;
          Value := '';
          Position := -1;
          Exit;
        end;
      until not isXmlWhiteSpace(S);

      case Ord(S) of
        $28: begin // '('
          Symbol := XPATH_LEFT_PARENTHESIS_TOKEN;
          FLastSymbol := XPATH_LEFT_PARENTHESIS_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $29: begin // ')'
          Symbol := XPATH_RIGHT_PARENTHESIS_TOKEN;
          FLastSymbol := XPATH_RIGHT_PARENTHESIS_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $5b: begin // '['
          Symbol := XPATH_LEFT_SQUARE_BRACKET_TOKEN;
          FLastSymbol := XPATH_LEFT_SQUARE_BRACKET_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $5d: begin // ']'
          Symbol := XPATH_RIGHT_SQUARE_BRACKET_TOKEN;
          FLastSymbol := XPATH_RIGHT_SQUARE_BRACKET_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $40: begin // '@'
          Symbol := XPATH_COMMERCIAL_AT_TOKEN;
          FLastSymbol := XPATH_COMMERCIAL_AT_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $2c: begin // ','
          Symbol := XPATH_COMMA_TOKEN;
          FLastSymbol := XPATH_COMMA_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $3a: begin // ':'
          LookAheadNextWideChar(L);
          if L = #$3a then begin // '::'
            Inc(FPosition);
            Symbol := XPATH_DOUBLE_COLON_TOKEN;
            FLastSymbol := XPATH_DOUBLE_COLON_TOKEN;
            Value := '';
            Position := FPosition;
          end else begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Value := ':';
            Position := FPosition;
          end;
        end;
        $7c: begin // '|'
          Symbol := XPATH_SHEFFER_STROKE_OPERATOR_TOKEN;
          FLastSymbol := XPATH_SHEFFER_STROKE_OPERATOR_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $2b: begin // '+'
          Symbol := XPATH_PLUS_OPERATOR_TOKEN;
          FLastSymbol := XPATH_PLUS_OPERATOR_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $2d: begin // '-'
          Symbol := XPATH_MINUS_OPERATOR_TOKEN;
          FLastSymbol := XPATH_MINUS_OPERATOR_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $3d: begin // '='
          Symbol := XPATH_IS_EQUAL_OPERATOR_TOKEN;
          FLastSymbol := XPATH_IS_EQUAL_OPERATOR_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $21: begin // '!'
          LookAheadNextWideChar(L);
          if L = #$3d then begin // '!='
            Inc(FPosition);
            Symbol := XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN;
            FLastSymbol := XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN;
            Value := '';
            Position := FPosition;
          end else begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Value := '!';
            Position := FPosition;
          end;
        end;
        $2f: begin // '/'
          LookAheadNextWideChar(L);
          if L = #$2f then begin // '//'
            Inc(FPosition);
            FDoubleSlashStatus:= SL_XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN_FOLLOWS;
          end;
          Symbol := XPATH_SLASH_OPERATOR_TOKEN;
          FLastSymbol := XPATH_SLASH_OPERATOR_TOKEN;
          Value := '';
          Position := FPosition;
        end;
        $3c: begin // '<'
          LookAheadNextWideChar(L);
          if L = #$3d then begin // '<='
            Inc(FPosition);
            Symbol := XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN;
            FLastSymbol := XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN;
          end else begin
            Symbol := XPATH_LESS_THAN_OPERATOR_TOKEN;
            FLastSymbol := XPATH_LESS_THAN_OPERATOR_TOKEN;
          end;
          Value := '';
          Position := FPosition;
        end;
        $3e: begin // '>'
          LookAheadNextWideChar(L);
          if L = #$3d then begin // '>='
            Inc(FPosition);
            Symbol := XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN;
            FLastSymbol := XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN;
          end else begin
            Symbol := XPATH_GREATER_THAN_OPERATOR_TOKEN;
            FLastSymbol := XPATH_GREATER_THAN_OPERATOR_TOKEN;
          end;
          Value := '';
          Position := FPosition;
        end;
        $2e: begin // '.'
          LookAheadNextWideChar(L);
          case Ord(L) of
            $2e: begin // '..'
              Inc(FPosition);
              Symbol := XPATH_DOUBLE_DOT_TOKEN;
              FLastSymbol := XPATH_DOUBLE_DOT_TOKEN;
              Value := '';
              Position := FPosition;
            end;
            $30..$39: begin // Digit
              Value := '.';
              repeat
                Inc(FPosition);
                Value := Concat(Value, WideString(L));
                LookAheadNextWideChar(L);
              until not (Ord(L) in [$30..$39]);
              Symbol := XPATH_NUMBER_TOKEN;
              FLastSymbol := XPATH_NUMBER_TOKEN;
              Position := FPosition;
            end;
          else // '.'
            Symbol := XPATH_SINGLE_DOT_TOKEN;
            FLastSymbol := XPATH_SINGLE_DOT_TOKEN;
            Value := '';
            Position := FPosition;
          end; {case ... else}
        end;
        $30..$39: begin // Digit
          Value := S;
          DecimalPointFound:= False;
          if LookAheadNextWideChar(S) then begin
            while (Ord(S) in [$30..$39]) or ((S = #$2e) and not DecimalPointFound) do begin
              Inc(FPosition);
              Value := Concat(Value, WideString(S));
              if S = #$2e then DecimalPointFound:= True;
              LookAheadNextWideChar(S);
            end;
          end;
          Symbol := XPATH_NUMBER_TOKEN;
          FLastSymbol := XPATH_NUMBER_TOKEN;
          Position := FPosition;
        end;
        $22: begin // '"'
          Value := '';
          if not GetNextWideChar(S) then begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Position := FPosition;
            Exit;
          end;
          while S <> #$22 do begin
            Value := Concat(Value, WideString(S));
            if not GetNextWideChar(S) then begin
              Symbol := XPATH_INVALID_TOKEN;
              FLastSymbol := XPATH_INVALID_TOKEN;
              Position := FPosition;
              Exit;
            end;
          end;
          Symbol := XPATH_LITERAL_TOKEN;
          FLastSymbol := XPATH_LITERAL_TOKEN;
          Position := FPosition;
        end;
        $27: begin // '"'
          Value := '';
          if not GetNextWideChar(S) then begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Position := FPosition;
            Exit;
          end;
          while S <> #$27 do begin
            Value := Concat(Value, WideString(S));
            if not GetNextWideChar(S) then begin
              Symbol := XPATH_INVALID_TOKEN;
              FLastSymbol := XPATH_INVALID_TOKEN;
              Position := FPosition;
              Exit;
            end;
          end;
          Symbol := XPATH_LITERAL_TOKEN;
          FLastSymbol := XPATH_LITERAL_TOKEN;
          Position := FPosition;
        end;
        $24: begin // '$'
          if not LookAheadNextWideChar(S) then begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Position := FPosition;
            Exit;
          end;
          if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin  // Letter or '_'?
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Position := FPosition;
            Value := WideString(S);
            Exit;
          end;
          Value := '';
          while IsXmlNCNameChar(S) do begin
            Inc(FPosition);
            Value := Concat(Value, WideString(S));
            if not LookAheadNextWideChar(S)
              then Break;
          end;
          if S = #$3a then begin // ':' ?
            Inc(FPosition);
            if not LookAheadNextWideChar(S) then begin
              Symbol := XPATH_INVALID_TOKEN;
              FLastSymbol := XPATH_INVALID_TOKEN;
              Position := FPosition;
              Value := Concat(Value, ':');
              Exit;
            end;
            if S = #$3a then begin // '::' ?
              Dec(FPosition);
            end else begin
              Value := Concat(Value, ':');
              if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin  // Letter or '_'?
                Symbol := XPATH_INVALID_TOKEN;
                FLastSymbol := XPATH_INVALID_TOKEN;
                Position := FPosition;
                Value := Concat(Value, WideString(S));
                Exit;
              end;
              while IsXmlNCNameChar(S) do begin
                Inc(FPosition);
                Value := Concat(Value, WideString(S));
                if not Self.LookAheadNextWideChar(S)
                  then Break;
              end;
            end;
          end;
          Symbol := XPATH_VARIABLE_REFERENCE_TOKEN;
          FLastSymbol := XPATH_VARIABLE_REFERENCE_TOKEN;
          Position := FPosition;
        end;
        $2a: begin // '*'
          if FLastSymbol in [ XPATH_LEFT_PARENTHESIS_TOKEN,
                              XPATH_LEFT_SQUARE_BRACKET_TOKEN,
                              XPATH_COMMERCIAL_AT_TOKEN,
                              XPATH_COMMA_TOKEN,
                              XPATH_DOUBLE_COLON_TOKEN,
                              XPATH_AND_OPERATOR_TOKEN,
                              XPATH_OR_OPERATOR_TOKEN,
                              XPATH_MOD_OPERATOR_TOKEN,
                              XPATH_DIV_OPERATOR_TOKEN,
                              XPATH_MULTIPLY_OPERATOR_TOKEN,
                              XPATH_SLASH_OPERATOR_TOKEN,
                              XPATH_SHEFFER_STROKE_OPERATOR_TOKEN,
                              XPATH_PLUS_OPERATOR_TOKEN,
                              XPATH_MINUS_OPERATOR_TOKEN,
                              XPATH_IS_EQUAL_OPERATOR_TOKEN,
                              XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN,
                              XPATH_LESS_THAN_OPERATOR_TOKEN,
                              XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN,
                              XPATH_GREATER_THAN_OPERATOR_TOKEN,
                              XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN,
                              XPATH_INVALID_TOKEN  // = no preceding token
                            ]
          then begin
            Symbol := XPATH_NAME_TEST_TOKEN;
            FLastSymbol := XPATH_NAME_TEST_TOKEN;
            Value := '*';
          end else begin
            Symbol := XPATH_MULTIPLY_OPERATOR_TOKEN;
            FLastSymbol := XPATH_MULTIPLY_OPERATOR_TOKEN;
            Value := '';
          end;
          Position := FPosition;
        end;
      else  {case ...}

        // Parse NCName:
        if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin  // Letter or '_'?
          Symbol := XPATH_INVALID_TOKEN;
          FLastSymbol := XPATH_INVALID_TOKEN;
          Position := FPosition;
          Value := WideString(S);
          Exit;
        end;
        Value := '';
        Dec(FPosition);
        while IsXmlNCNameChar(S) do begin
          Inc(FPosition);
          Value := Concat(Value, WideString(S));
          if not LookAheadNextWideChar(S)
            then Break;
        end;

        if not ( FLastSymbol in [ XPATH_LEFT_PARENTHESIS_TOKEN,
                                  XPATH_LEFT_SQUARE_BRACKET_TOKEN,
                                  XPATH_COMMERCIAL_AT_TOKEN,
                                  XPATH_COMMA_TOKEN,
                                  XPATH_DOUBLE_COLON_TOKEN,
                                  XPATH_AND_OPERATOR_TOKEN,
                                  XPATH_OR_OPERATOR_TOKEN,
                                  XPATH_MOD_OPERATOR_TOKEN,
                                  XPATH_DIV_OPERATOR_TOKEN,
                                  XPATH_MULTIPLY_OPERATOR_TOKEN,
                                  XPATH_SLASH_OPERATOR_TOKEN,
                                  XPATH_SHEFFER_STROKE_OPERATOR_TOKEN,
                                  XPATH_PLUS_OPERATOR_TOKEN,
                                  XPATH_MINUS_OPERATOR_TOKEN,
                                  XPATH_IS_EQUAL_OPERATOR_TOKEN,
                                  XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN,
                                  XPATH_LESS_THAN_OPERATOR_TOKEN,
                                  XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN,
                                  XPATH_GREATER_THAN_OPERATOR_TOKEN,
                                  XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN,
                                  XPATH_INVALID_TOKEN  // = no preceding token
                                ] )
        then begin
          if Value = 'and' then begin
            Symbol := XPATH_AND_OPERATOR_TOKEN;
            FLastSymbol := XPATH_AND_OPERATOR_TOKEN;
            Value := '';
          end else if Value = 'or' then begin
            Symbol := XPATH_OR_OPERATOR_TOKEN;
            FLastSymbol := XPATH_OR_OPERATOR_TOKEN;
            Value := '';
          end else if Value = 'mod' then begin
            Symbol := XPATH_MOD_OPERATOR_TOKEN;
            FLastSymbol := XPATH_MOD_OPERATOR_TOKEN;
            Value := '';
          end else if Value = 'div' then begin
            Symbol := XPATH_DIV_OPERATOR_TOKEN;
            FLastSymbol := XPATH_DIV_OPERATOR_TOKEN;
            Value := '';
          end else begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
          end;
          Position := FPosition;
          Exit;
        end;

        if DoubleColonFollows then begin
          if Value = 'ancestor' then begin
            Symbol := XPATH_AXIS_NAME_ANCESTOR_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_ANCESTOR_TOKEN;
            Value := '';
          end else if Value = 'ancestor-or-self' then begin
            Symbol := XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN;
            Value := '';
          end else if Value = 'attribute' then begin
            Symbol := XPATH_AXIS_NAME_ATTRIBUTE_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_ATTRIBUTE_TOKEN;
            Value := '';
          end else if Value = 'child' then begin
            Symbol := XPATH_AXIS_NAME_CHILD_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_CHILD_TOKEN;
            Value := '';
          end else if Value = 'descendant' then begin
            Symbol := XPATH_AXIS_NAME_DESCENDANT_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_DESCENDANT_TOKEN;
            Value := '';
          end else if Value = 'descendant-or-self' then begin
            Symbol := XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN;
            Value := '';
          end else if Value = 'following' then begin
            Symbol := XPATH_AXIS_NAME_FOLLOWING_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_FOLLOWING_TOKEN;
            Value := '';
          end else if Value = 'following-sibling' then begin
            Symbol := XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN;
            Value := '';
          end else if Value = 'namespace' then begin
            Symbol := XPATH_AXIS_NAME_NAMESPACE_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_NAMESPACE_TOKEN;
            Value := '';
          end else if Value = 'parent' then begin
            Symbol := XPATH_AXIS_NAME_PARENT_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_PARENT_TOKEN;
            Value := '';
          end else if Value = 'preceding' then begin
            Symbol := XPATH_AXIS_NAME_PRECEDING_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_PRECEDING_TOKEN;
          end else if Value = 'preceding-sibling' then begin
            Symbol := XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN;
            Value := '';
          end else if Value = 'self' then begin
            Symbol := XPATH_AXIS_NAME_SELF_TOKEN;
            FLastSymbol := XPATH_AXIS_NAME_SELF_TOKEN;
            Value := '';
          end else begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Value := '';
          end;
          Position := FPosition;
          Exit;
        end;

        if S = #$3a then begin // ':' ?
          Inc(FPosition);
          if not LookAheadNextWideChar(S) then begin
            Symbol := XPATH_INVALID_TOKEN;
            FLastSymbol := XPATH_INVALID_TOKEN;
            Position := FPosition;
            Value := Concat(Value, ':');
            Exit;
          end;
          if S = #$3a then begin // '::' ?
            Dec(FPosition);
          end else begin
            Value := Concat(Value, ':');
            if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin  // Letter or '_'?
              if S = #$2a then begin // '*
                Symbol := XPATH_NAME_TEST_TOKEN;
                FLastSymbol := XPATH_NAME_TEST_TOKEN;
              end else begin
                Symbol := XPATH_INVALID_TOKEN;
                FLastSymbol := XPATH_INVALID_TOKEN;
              end;
              Inc(FPosition);
              Position := FPosition;
              Value := Concat(Value, WideString(S));
              Exit;
            end;
            while IsXmlNCNameChar(S) do begin
              Inc(FPosition);
              Value := Concat(Value, WideString(S));
              if not Self.LookAheadNextWideChar(S)
                then Break;
            end;
          end;
        end;

        if leftParanthesisFollows then begin
          if Value = 'comment' then begin
            Symbol := XPATH_NODE_TYPE_COMMENT_TOKEN;
            FLastSymbol := XPATH_NODE_TYPE_COMMENT_TOKEN;
            Value := '';
          end else if Value = 'text' then begin
            Symbol := XPATH_NODE_TYPE_TEXT_TOKEN;
            FLastSymbol := XPATH_NODE_TYPE_TEXT_TOKEN;
            Value := '';
          end else if Value = 'processing-instruction' then begin
            Symbol := XPATH_NODE_TYPE_PI_TOKEN;
            FLastSymbol := XPATH_NODE_TYPE_PI_TOKEN;
            Value := '';
          end else if Value = 'node' then begin
            Symbol := XPATH_NODE_TYPE_NODE_TOKEN;
            FLastSymbol := XPATH_NODE_TYPE_NODE_TOKEN;
            Value := '';
          end else begin
            Symbol := XPATH_FUNCTION_NAME_TOKEN;
            FLastSymbol := XPATH_FUNCTION_NAME_TOKEN;
          end;
        end else begin
          Symbol := XPATH_NAME_TEST_TOKEN;
          FLastSymbol := XPATH_NAME_TEST_TOKEN;
        end;
        Position := FPosition;

      end; {case ... else ...}

    end;
    SL_XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN_FOLLOWS: begin
      Symbol := XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN;
      // FLastSymbol := XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN;
      // FLastSymbol will never be evaluated, so we do not need to set it.
      Position := FPosition;
      Value := '';
      FDoubleSlashStatus:= SL_XPATH_DOUBLE_COLON_TOKEN_FOLLOWS;
    end;
    SL_XPATH_DOUBLE_COLON_TOKEN_FOLLOWS: begin
      Symbol := XPATH_DOUBLE_COLON_TOKEN;
      // FLastSymbol := XPATH_DOUBLE_COLON_TOKEN;
      // FLastSymbol will never be evaluated, so we do not need to set it.
      Position := FPosition;
      Value := '';
      FDoubleSlashStatus:= SL_XPATH_NODE_TYPE_NODE_TOKEN_FOLLOWS;
    end;
    SL_XPATH_NODE_TYPE_NODE_TOKEN_FOLLOWS: begin
      Symbol := XPATH_NODE_TYPE_NODE_TOKEN;
      // FLastSymbol := XPATH_NODE_TYPE_NODE_TOKEN;
      // FLastSymbol will never be evaluated, so we do not need to set it.
      Position := FPosition;
      Value := '';
      FDoubleSlashStatus:= SL_XPATH_LEFT_PARENTHESIS_FOLLOWS;
    end;
    SL_XPATH_LEFT_PARENTHESIS_FOLLOWS: begin
      Symbol := XPATH_LEFT_PARENTHESIS_TOKEN;
      // FLastSymbol := XPATH_LEFT_PARENTHESIS_TOKEN;
      // FLastSymbol will never be evaluated, so we do not need to set it.
      Position := FPosition;
      Value := '';
      FDoubleSlashStatus:= SL_XPATH_RIGHT_PARENTHESIS_FOLLOWS;
    end;
    SL_XPATH_RIGHT_PARENTHESIS_FOLLOWS: begin
      Symbol := XPATH_RIGHT_PARENTHESIS_TOKEN;
      // FLastSymbol := XPATH_RIGHT_PARENTHESIS_TOKEN;
      // FLastSymbol will never be evaluated, so we do not need to set it.
      Position := FPosition;
      Value := '';
      FDoubleSlashStatus:= SL_XPATH_SLASH_OPERATOR_TOKEN_FOLLLOWS;
    end;
    SL_XPATH_SLASH_OPERATOR_TOKEN_FOLLLOWS: begin
      Symbol := XPATH_SLASH_OPERATOR_TOKEN;
      FLastSymbol := XPATH_SLASH_OPERATOR_TOKEN;
      Position := FPosition;
      Value := '';
      FDoubleSlashStatus:= SL_NO_DOUBLE_SLASH;
    end;
  end; {case FDoubleSlashStatus ...}
end;

procedure TDomXPathTokenizer.Reset;
begin
  FCacheIsActive:= False;
  FLastSymbol := XPATH_INVALID_TOKEN;  // Use XPATH_INVALID_TOKEN as a dummy value
  FPosition:= 0;
  FDoubleSlashStatus:= SL_NO_DOUBLE_SLASH;
end;

{ TDomXPathCustomResult }

constructor TDomXPathCustomResult.Create;
begin
  inherited Create(nil);
end;

function TDomXPathCustomResult.GetAxisType: TDomXPathAxisType;
begin
  Result := XPATH_FORWARD_AXIS;
end;

function TDomXPathCustomResult.Item(const Index: Integer): TDomNode;
begin
  Result := nil;
end;

function TDomXPathCustomResult.Length: Integer;
begin
  Result := 0;
end;

procedure TDomXPathCustomResult.SetAxisType(const Value: TDomXPathAxisType);
begin
  // By default do nothing.
end;

{ TDomXPathNodeSetResult }

constructor TDomXPathNodeSetResult.Create;
begin
  inherited Create;
  FAxisType := XPATH_FORWARD_AXIS;
  FList:= TList.Create;
end;

destructor TDomXPathNodeSetResult.Destroy;
begin
  FList.Free;
  inherited;
end;

procedure TDomXPathNodeSetResult.Add(const Node: TDomNode);
begin
  if Node.NodeType = ntXPath_Namespace_Node
    then with Node as TDomXPathNamespace do
      AddXPathNamespace(OwnerElement, NamespaceUri, Prefix)
    else FList.Add(Node);
end;

procedure TDomXPathNodeSetResult.AddSubtree(const Node: TDomNode);
// Adds 'node' and its subtree, excluding attributes.
var
  N: TDomNode;
  BufferList: TList;
  I: Integer;
begin
  if AxisType = XPATH_FORWARD_AXIS then begin
    if Assigned(Node) then begin
      with Node.RootDocument.CreateNodeIterator( Node,
                                                  [ ntElement_Node,
                                                    ntText_Node,
                                                    ntCDATA_Section_Node,
                                                    ntEntity_Reference_Node,
                                                    ntProcessing_Instruction_Node,
                                                    ntComment_Node,
                                                    ntDocument_Node ],
                                                  nil,
                                                  False ) do begin
        N := NextNode;
        while Assigned(N) do begin
          FList.Add(N);
          N := NextNode;
        end;
        Detach;
      end;
      Node.RootDocument.ClearInvalidNodeIterators;
    end;
  end else begin
    if Assigned(Node) then begin
      BufferList:= TList.Create;
      try
        with Node.RootDocument.CreateNodeIterator( Node,
                                                    [ ntElement_Node,
                                                      ntText_Node,
                                                      ntCDATA_Section_Node,
                                                      ntEntity_Reference_Node,
                                                      ntProcessing_Instruction_Node,
                                                      ntComment_Node,
                                                      ntDocument_Node ],
                                                    nil,
                                                    False ) do begin
          N := NextNode;
          while Assigned(N) do begin
            BufferList.Add(N);
            N := NextNode;
          end;
          Detach;
        end;
        Node.RootDocument.ClearInvalidNodeIterators;

        for I := Pred(BufferList.Count) downto 0 do
          FList.Add(BufferList[I]);

      finally
        BufferList.Free;
      end;
    end;
  end;
end;

procedure TDomXPathNodeSetResult.AddXPathNamespace(const AOwnerElement: TDomElement;
                                                   const ANamespaceUri,
                                                         APrefix: WideString);
begin
  FList.Add(CreateXPathNamespace(AOwnerElement, ANamespaceUri, APrefix));
end;

function TDomXPathNodeSetResult.AsBoolean: Boolean;
begin
  Result := Length > 0;
end;

function TDomXPathNodeSetResult.AsNumber: Double;
begin
  Result := XPathWideStringToNumber(AsWideString);
end;

function TDomXPathNodeSetResult.AsWideString: WideString;
begin
  if Length = 0 then begin
    Result := ''
  end else if AxisType = XPATH_FORWARD_AXIS then begin
    Result := Item(0).XPathStringValue;
  end else Result := Item(Length).XPathStringValue;
end;

function TDomXPathNodeSetResult.CreateXPathNamespace(const AOwnerElement: TDomElement;
                                                     const ANamespaceUri,
                                                           APrefix: WideString): TDomXPathNamespace;
begin
  Result := TDomXPathNamespace.Create(Self, AOwnerElement, ANamespaceUri, APrefix);
end;

procedure TDomXPathNodeSetResult.Clear;
var
  I: Integer;
begin
  // Free all XPath Namespace nodes:
  for I := 0 to Pred(FList.Count) do
    if TDomNode(FList[I]).NodeType = ntXPath_Namespace_Node then
      TDomNode(FList[I]).Free;
  FList.Clear;
end;

procedure TDomXPathNodeSetResult.Delete(const Index: Integer);
begin
  // If the node is an XPath Namespace node then free it:
  if TDomNode(FList[Index]).NodeType = ntXPath_Namespace_Node then
    TDomNode(FList[Index]).Free;
  FList.Delete(Index);
end;

function TDomXPathNodeSetResult.GetAxisType: TDomXPathAxisType;
begin
  Result := FAxisType;
end;

procedure TDomXPathNodeSetResult.Insert(const Index: Integer;
                                        const Node: TDomNode);
begin
  if Node.NodeType = ntXPath_Namespace_Node
    then with Node as TDomXPathNamespace do
      FList.Insert(Index, CreateXPathNamespace(OwnerElement, NamespaceUri, Prefix))
    else FList.Insert(Index, Node);
end;

function TDomXPathNodeSetResult.Item(const Index: Integer): TDomNode;
begin
  if (Index < 0) or (Index >= FList.Count)
    then Result := nil
    else Result := TDomNode(FList.List^[Index]);
end;

function TDomXPathNodeSetResult.Length: Integer;
begin
  Result := FList.Count;
end;

procedure TDomXPathNodeSetResult.Merge(const NodeSet: TDomXPathNodeSetResult);
// Merges two sorted TDomXPathNodeSetResult objects.
var
  I, X, Y: Integer;
  DocPos: TDomDocumentPosition;
  EquivalentItems: TList;
begin
  if nodeSet = Self then Exit;
  nodeSet.AxisType := AxisType;
  X:= 0;
  Y:= 0;
  EquivalentItems:= TList.Create;
  try

    if AxisType = XPATH_FORWARD_AXIS then begin
      while (X < Length) and (Y < nodeSet.Length) do begin
        DocPos:= Item(X).CompareDocumentPosition(nodeSet.Item(Y));
        if (Document_Position_Same_Node in DocPos) then begin
          Inc(Y);
        end else if (Document_Position_Equivalent in DocPos) then begin
          EquivalentItems.Add(nodeSet.Item(Y));
          Inc(Y);
        end else if (Document_Position_Following in DocPos) then begin
          Inc(X);
          for I := Pred(EquivalentItems.Count) downto 0 do
            if (Document_Position_Same_Node in Item(X).CompareDocumentPosition(EquivalentItems[I]))
              then EquivalentItems.Delete(I);
        end else if (Document_Position_Disconnected in DocPos) then begin
          for I := 0 to Pred(EquivalentItems.Count) do begin
            Insert(X,EquivalentItems[I]);
            EquivalentItems.Delete(I);
            Inc(X);
          end;
          Inc(X);
        end else begin
          for I := 0 to Pred(EquivalentItems.Count) do begin
            Insert(X,EquivalentItems[I]);
            EquivalentItems.Delete(I);
            Inc(X);
          end;
          Insert(X,nodeSet.Item(Y));
          Inc(X);
          Inc(Y);
        end;
      end;
    end else begin
      while (X < Length) and (Y < nodeSet.Length) do begin
        DocPos:= Item(X).CompareDocumentPosition(nodeSet.Item(Y));
        if (Document_Position_Same_Node in DocPos) then begin
          Inc(Y);
        end else if (Document_Position_Equivalent in DocPos) then begin
          EquivalentItems.Add(nodeSet.Item(Y));
          Inc(Y);
        end else if (Document_Position_Preceding in DocPos) then begin
          Inc(X);
          for I := Pred(EquivalentItems.Count) downto 0 do
            if (Document_Position_Same_Node in Item(X).CompareDocumentPosition(EquivalentItems[I]))
              then EquivalentItems.Delete(I);
        end else if (Document_Position_Disconnected in DocPos) then begin
          for I := 0 to Pred(EquivalentItems.Count) do begin
            Insert(X,EquivalentItems[I]);
            EquivalentItems.Delete(I);
            Inc(X);
          end;
          Inc(X);
        end else begin
          for I := 0 to Pred(EquivalentItems.Count) do begin
            Insert(X,EquivalentItems[I]);
            EquivalentItems.Delete(I);
            Inc(X);
          end;
          Insert(X,nodeSet.Item(Y));
          Inc(X);
          Inc(Y);
        end;
      end;
    end;

    Inc(X);
    while (EquivalentItems.Count > 0) and (X < Length) do begin
      if not (Document_Position_Equivalent in Item(X).CompareDocumentPosition(EquivalentItems[0])) then begin
        for I := 0 to Pred(EquivalentItems.Count) do begin
          Insert(X,EquivalentItems[I]);
          EquivalentItems.Delete(I);
        end;
      end;
      for I := Pred(EquivalentItems.Count) downto 0 do
        if (Document_Position_Same_Node in Item(X).CompareDocumentPosition(EquivalentItems[I]))
          then EquivalentItems.Delete(I);
      Inc(X);
    end;

    for I := 0 to Pred(EquivalentItems.Count) do
      Add(EquivalentItems[I]);

    if Y < nodeSet.Length then
      for I := Y to Pred(nodeSet.Length) do
        Add(nodeSet.Item(I));

  finally
    EquivalentItems.Free;
  end;
end;

function TDomXPathNodeSetResult.ResultType: TDomXPathResultType;
begin
  Result := XPATH_NODE_SET_TYPE;
end;

procedure TDomXPathNodeSetResult.SetAxisType(const Value: TDomXPathAxisType);
var
  Item: Pointer;
  index1,index2,J: Integer;
begin
  if FAxisType <> Value then begin
    FAxisType := Value;
    J := Pred(FList.Count);
    if J >= 0 then begin
      for index1:= 0 to ( J shr 1 ) do begin
        index2:= J - index1;
        Item:= FList.List^[index1];
        FList.List^[index1]:= FList.List^[index2];
        FList.List^[index2]:= Item;
        // Remark: FList.exchange(index1, index2) could have been used here
        //         instead, but re-implementing the swaping is faster, because
        //         parameter tests are avoided.
      end;
    end;
  end;
end;

procedure TDomXPathNodeSetResult.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TDomXPathNodeSetResult then begin
    if Source = Self then Exit;
    Clear;
    AxisType := TDomXPathNodeSetResult(Source).AxisType;
    for I := 0 to Pred(TDomXPathNodeSetResult(Source).Length) do
      Add(TDomXPathNodeSetResult(Source).Item(I));
  end else if Source is TXPathExpression then begin
    if TXPathExpression(Source).FXPathResult = Self then Exit;
    Clear;
    AxisType := TXPathExpression(Source).ResultAxisType;
    for I := 0 to Pred(TXPathExpression(Source).ResultLength) do
      Add(TXPathExpression(Source).ResultNode(I));
  end else inherited Assign(Source);
end;

function CompareNodePosForwardAxis(Item1, Item2: Pointer): Integer;
var
  DocPos: TDomDocumentPosition;
begin
  DocPos := TDomNode(Item1).CompareDocumentPosition(TDomNode(Item2));
  if Document_Position_Following in DocPos then
    Result := -1
  else if Document_Position_Preceding in DocPos then
    Result := 1
  else
    Result := 0;
end;

function CompareNodePosReverseAxis(Item1, Item2: Pointer): Integer;
var
  DocPos: TDomDocumentPosition;
begin
  DocPos := TDomNode(Item1).CompareDocumentPosition(TDomNode(Item2));
  if Document_Position_Following in DocPos then
    Result := 1
  else if Document_Position_Preceding in DocPos then
    Result := -1
  else
    Result := 0;
end;

procedure TDomXPathNodeSetResult.Sort;
begin
  if AxisType = XPATH_FORWARD_AXIS then
    FList.Sort(CompareNodePosForwardAxis)
  else
    FList.Sort(CompareNodePosReverseAxis);
end;

{ TDomXPathBooleanResult }

constructor TDomXPathBooleanResult.Create(const ABooleanValue: Boolean);
begin
  inherited Create;
  FBooleanValue := ABooleanValue;
end;

function TDomXPathBooleanResult.AsBoolean: Boolean;
begin
  Result := FBooleanValue;
end;

function TDomXPathBooleanResult.AsNumber: Double;
begin
  if AsBoolean
    then Result := 1
    else Result := 0;
end;

function TDomXPathBooleanResult.AsWideString: WideString;
begin
  if AsBoolean
    then Result := 'true'
    else Result := 'false';
end;

function TDomXPathBooleanResult.ResultType: TDomXPathResultType;
begin
  Result := XPATH_BOOLEAN_TYPE;
end;

{ TDomXPathNumberResult }

constructor TDomXPathNumberResult.Create(const ANumberValue: Double);
begin
  inherited Create;
  FNumberValue := ANumberValue;
end;

function TDomXPathNumberResult.AsBoolean: Boolean;
begin
  Result := not( (AsNumber = 0) or IsNaN(AsNumber) );
end;

function TDomXPathNumberResult.AsNumber: Double;
begin
  Result := FNumberValue;
end;

function TDomXPathNumberResult.AsWideString: WideString;
begin
  if IsNaN(AsNumber) then begin
    Result := 'NaN';
  end else if IsInfinite(AsNumber) then begin
    if Sign(AsNumber) = 1
      then Result := 'Infinity'
      else Result := '-Infinity';
  end else Result := FloatToStr(AsNumber);
end;

function TDomXPathNumberResult.ResultType: TDomXPathResultType;
begin
  Result := XPATH_NUMBER_TYPE;
end;

{ TDomXPathStringResult }

constructor TDomXPathStringResult.Create(const AStringValue: WideString);
begin
  inherited Create;
  FStringValue := AStringValue;
end;

function TDomXPathStringResult.AsBoolean: Boolean;
begin
  Result := system.Length(AsWideString) > 0;
end;

function TDomXPathStringResult.AsNumber: Double;
begin
  Result := XPathWideStringToNumber(AsWideString);
end;

function TDomXPathStringResult.AsWideString: WideString;
begin
  Result := FStringValue;
end;

function TDomXPathStringResult.ResultType: TDomXPathResultType;
begin
  Result := XPATH_STRING_TYPE;
end;

{ TDomXPathSyntaxTree }

constructor TDomXPathSyntaxTree.Create(AOwner: TXPathExpression);
begin
  inherited Create(nil);
  FOwnerXPathExpression := AOwner;
end;

procedure TDomXPathSyntaxTree.Clear;
begin
  inherited;
  FRootExpr := nil; // Remark: FRootExpr was freed in the inherited Clear procedure.
end;

function TDomXPathSyntaxTree.CreateSyntaxNode(const Symbol: TDomXPathTokenType;
                                              const Value: WideString): TDomXPathSyntaxNode;
begin
  case Symbol of
    XPATH_LEFT_PARENTHESIS_TOKEN:
      Result := TDomXPathLeftParenthesis.Create(Self, Value);
    XPATH_RIGHT_PARENTHESIS_TOKEN:
      Result := TDomXPathRightParenthesis.Create(Self, Value);
    XPATH_LEFT_SQUARE_BRACKET_TOKEN:
      Result := TDomXPathLeftSquareBracket.Create(Self, Value);
    XPATH_RIGHT_SQUARE_BRACKET_TOKEN:
      Result := TDomXPathRightSquareBracket.Create(Self, Value);
    XPATH_SINGLE_DOT_TOKEN:
      Result := TDomXPathSingleDot.Create(Self, Value);
    XPATH_DOUBLE_DOT_TOKEN:
      Result := TDomXPathDoubleDot.Create(Self, Value);
    XPATH_COMMERCIAL_AT_TOKEN:
      Result := TDomXPathCommercialAt.Create(Self, Value);
    XPATH_COMMA_TOKEN:
      Result := TDomXPathComma.Create(Self, Value);
    XPATH_DOUBLE_COLON_TOKEN:
      Result := TDomXPathDoubleColon.Create(Self, Value);
    XPATH_NAME_TEST_TOKEN:
      Result := TDomXPathNameTest.Create(Self, Value);
    XPATH_NODE_TYPE_COMMENT_TOKEN:
      Result := TDomXPathNodeTypeComment.Create(Self, Value);
    XPATH_NODE_TYPE_TEXT_TOKEN:
      Result := TDomXPathNodeTypeText.Create(Self, Value);
    XPATH_NODE_TYPE_PI_TOKEN:
      Result := TDomXPathNodeTypePI.Create(Self, Value);
    XPATH_NODE_TYPE_NODE_TOKEN:
      Result := TDomXPathNodeTypeNode.Create(Self, Value);
    XPATH_AND_OPERATOR_TOKEN:
      Result := TDomXPathAndOperator.Create(Self, Value);
    XPATH_OR_OPERATOR_TOKEN:
      Result := TDomXPathOrOperator.Create(Self, Value);
    XPATH_MOD_OPERATOR_TOKEN:
      Result := TDomXPathModOperator.Create(Self, Value);
    XPATH_DIV_OPERATOR_TOKEN:
      Result := TDomXPathDivOperator.Create(Self, Value);
    XPATH_MULTIPLY_OPERATOR_TOKEN:
      Result := TDomXPathMultiplyOperator.Create(Self, Value);
    XPATH_SLASH_OPERATOR_TOKEN:
      Result := TDomXPathSlashOperator.Create(Self, Value);
    XPATH_SHEFFER_STROKE_OPERATOR_TOKEN:
      Result := TDomXPathShefferStrokeOperator.Create(Self, Value);
    XPATH_PLUS_OPERATOR_TOKEN:
      Result := TDomXPathPlusOperator.Create(Self, Value);
    XPATH_MINUS_OPERATOR_TOKEN:
      Result := TDomXPathMinusOperator.Create(Self, Value);
    XPATH_IS_EQUAL_OPERATOR_TOKEN:
      Result := TDomXPathIsEqualOperator.Create(Self, Value);
    XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN:
      Result := TDomXPathIsNotEqualOperator.Create(Self, Value);
    XPATH_LESS_THAN_OPERATOR_TOKEN:
      Result := TDomXPathLessThanOperator.Create(Self, Value);
    XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN:
      Result := TDomXPathLessThanOrEqualOperator.Create(Self, Value);
    XPATH_GREATER_THAN_OPERATOR_TOKEN:
      Result := TDomXPathGreaterThanOperator.Create(Self, Value);
    XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN:
      Result := TDomXPathGreaterThanOrEqualOperator.Create(Self, Value);
    XPATH_FUNCTION_NAME_TOKEN:
      Result := TDomXPathFunctionName.Create(Self, Value); 
    XPATH_AXIS_NAME_ANCESTOR_TOKEN:
      Result := TDomXPathAxisNameAncestor.Create(Self, Value);
    XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN:
      Result := TDomXPathAxisNameAncestorOrSelf.Create(Self, Value);
    XPATH_AXIS_NAME_ATTRIBUTE_TOKEN:
      Result := TDomXPathAxisNameAttribute.Create(Self, Value);
    XPATH_AXIS_NAME_CHILD_TOKEN:
      Result := TDomXPathAxisNameChild.Create(Self, Value);
    XPATH_AXIS_NAME_DESCENDANT_TOKEN:
      Result := TDomXPathAxisNameDescendant.Create(Self, Value);
    XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN:
      Result := TDomXPathAxisNameDescendantOrSelf.Create(Self, Value);
    XPATH_AXIS_NAME_FOLLOWING_TOKEN:
      Result := TDomXPathAxisNameFollowing.Create(Self, Value);
    XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN:
      Result := TDomXPathAxisNameFollowingSibling.Create(Self, Value);
    XPATH_AXIS_NAME_NAMESPACE_TOKEN:
      Result := TDomXPathAxisNameNamespace.Create(Self, Value);
    XPATH_AXIS_NAME_PARENT_TOKEN:
      Result := TDomXPathAxisNameParent.Create(Self, Value);
    XPATH_AXIS_NAME_PRECEDING_TOKEN:
      Result := TDomXPathAxisNamePreceding.Create(Self, Value);
    XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN:
      Result := TDomXPathAxisNamePrecedingSibling.Create(Self, Value);
    XPATH_AXIS_NAME_SELF_TOKEN:
      Result := TDomXPathAxisNameSelf.Create(Self, Value);
    XPATH_LITERAL_TOKEN:
      Result := TDomXPathLiteral.Create(Self, Value);
    XPATH_NUMBER_TOKEN:
      Result := TDomXPathNumber.Create(Self, Value);
    XPATH_VARIABLE_REFERENCE_TOKEN:
      Result := TDomXPathVariableReference.Create(Self, Value);
  else
    Result := nil;
  end;
end;

function TDomXPathSyntaxTree.Evaluate: TDomXPathCustomResult;
begin
  if Assigned(ContextNode) then
    if not (ContextNode.NodeType in [ ntElement_Node,
                                      ntAttribute_Node,
                                      ntText_Node,
                                      ntProcessing_Instruction_Node,
                                      ntComment_Node,
                                      ntDocument_Node,
                                      ntXPath_Namespace_Node ] ) then
        raise ENot_Supported_Err.Create('Not supported error.');
  if not Assigned(FRootExpr) then
    raise EXPath_Invalid_Expression_Err.Create('No valid XPath expression prepared.');
  Result := FRootExpr.Evaluate(ContextNode, 1, 1);
end;

function TDomXPathSyntaxTree.GetIsPrepared: Boolean;
begin
  Result := Assigned(FRootExpr);
end;

function TDomXPathSyntaxTree.Prepare(const Expression: WideString): Boolean;
var
  Position: Integer;
  Stack: TDomXPathSyntaxNodeStack;
  Symbol: TDomXPathTokenType;
  Tokenizer: TDomXPathTokenizer;
  Value: WideString;
  AxisNode: TDomXPathSyntaxNode;
  LastSyntaxNode: TDomXPathSyntaxNode;
  NewSyntaxNode: TDomXPathSyntaxNode;
  NodeTestNode: TDomXPathSyntaxNode;
  FunctionCallNode: TDomXPathFunctionCall;
  NodeTypePI: TDomXPathSyntaxNode;
  PILiteral: TDomXPathSyntaxNode;
begin
  Clear; // Free the root expression, if any, and all its children.
  Tokenizer := TDomXPathTokenizer.Create(Expression,'1.0');
  try
    Stack:= TDomXPathSyntaxNodeStack.Create;
    try
      repeat
        Tokenizer.Read(Symbol, Value, position);
        case Symbol of
        XPATH_END_OF_TEXT_TOKEN, XPATH_INVALID_TOKEN: Break;
        else
          LastSyntaxNode:= CreateSyntaxNode(Symbol, Value);
          repeat
            // -- if LastSyntaxNode is TDomXPathAbsoluteLocationPath then ... --
            // (TDomXPathAbsoluteLocationPath will not appear in this loop,
            // so we leave it out here.)
            if LastSyntaxNode is TDomXPathAndExpr then begin
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_DIV_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MOD_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_PLUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MINUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_IS_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_AND_OPERATOR_TOKEN)
              then begin
                // Operator of higher precedence is following, so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if (Stack.Peek(0) is TDomXPathOrOperator) and
                 ( (Stack.Peek(1) is TDomXPathOrExpr) )
              then begin
                // XPath 1.0, prod. [21]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathOrExpr.Create(Self, ''); // Create OrExpr.
                NewSyntaxNode.Left:= Stack.Pop;                   // Append OrExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;             // Append AndExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [21]:
                NewSyntaxNode:= TDomXPathOrExpr.Create(Self, ''); // Create OrExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;              // Append AndExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if (LastSyntaxNode is TDomXPathAndOperator) or
                        (LastSyntaxNode is TDomXPathComma) or
                        (LastSyntaxNode is TDomXPathCommercialAt) or
                        (LastSyntaxNode is TDomXPathCustomAxisName)
            then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if (LastSyntaxNode is TDomXPathDivExpr) or
                        (LastSyntaxNode is TDomXPathModExpr) or
                        (LastSyntaxNode is TDomXPathMultiplyExpr)
            then begin
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_DIV_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MOD_OPERATOR_TOKEN)
              then begin
                // Operator of higher precedence is following, so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if (Stack.Peek(0) is TDomXPathPlusOperator) and
                 ( (Stack.Peek(1) is TDomXPathPlusExpr) or
                   (Stack.Peek(1) is TDomXPathMinusExpr) )
              then begin
                // XPath 1.0, prod. [25]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathPlusExpr.Create(Self, ''); // Create PlusExpr.
                NewSyntaxNode.Left:= Stack.Pop;                     // Append AdditiveExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;               // Append MultiplicativeExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathMinusOperator) and
                 ( (Stack.Peek(1) is TDomXPathPlusExpr) or
                   (Stack.Peek(1) is TDomXPathMinusExpr) )
              then begin
                // XPath 1.0, prod. [25]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathMinusExpr.Create(Self, ''); // Create MinusExpr.
                NewSyntaxNode.Left:= Stack.Pop;                      // Append AdditiveExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                // Append MultiplicativeExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [25]:
                NewSyntaxNode:= TDomXPathPlusExpr.Create(Self, ''); // Create PlusExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;                // Append MultiplicativeExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if (LastSyntaxNode is TDomXPathDivOperator) or
                        (LastSyntaxNode is TDomXPathDoubleColon)
            then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if LastSyntaxNode is TDomXPathDoubleDot then begin
              // XPath 1.0, prod. [12]:
              LastSyntaxNode.Free;
              LastSyntaxNode:= TDomXPathStep.Create(Self, '');
              LastSyntaxNode.Left:= TDomXPathAxisNameParent.Create(Self, '');
              LastSyntaxNode.Left.Left:= TDomXPathNodeTest.Create(Self, '');
              LastSyntaxNode.Left.Left.Left:= TDomXPathNodeTypeNode.Create(Self, '');
            end else if LastSyntaxNode is TDomXPathExpr then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if LastSyntaxNode is TDomXPathFilterExpr then begin
              // XPath 1.0, prod. [19]:
              if Tokenizer.IsFollowing(XPATH_SLASH_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LEFT_SQUARE_BRACKET_TOKEN)
              then begin
                // A Slash or Predicate is following, so we postpone building the PathExpr.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              NewSyntaxNode:= TDomXPathPathExpr.Create(Self, ''); // Create PathExpr.
              NewSyntaxNode.Left:= LastSyntaxNode;                // Append FilterExpr.
              LastSyntaxNode:= NewSyntaxNode;
            end else if LastSyntaxNode is TDomXPathFunctionName then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if (LastSyntaxNode is TDomXPathGreaterThanExpr) or
                        (LastSyntaxNode is TDomXPathGreaterThanOrEqualExpr) or
                        (LastSyntaxNode is TDomXPathLessThanExpr) or
                        (LastSyntaxNode is TDomXPathLessThanOrEqualExpr)
            then begin
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_DIV_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MOD_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_PLUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MINUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN)
              then begin
                // Operator of higher precedence is following, so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if (Stack.Peek(0) is TDomXPathIsEqualOperator) and
                 ( (Stack.Peek(1) is TDomXPathIsEqualExpr) or
                   (Stack.Peek(1) is TDomXPathIsNotEqualExpr) )
              then begin
                // XPath 1.0, prod. [23]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathIsEqualExpr.Create(Self, ''); // Create IsEqualExpr.
                NewSyntaxNode.Left:= Stack.Pop;                        // Append EqualityExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                  // Append RelationalExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathIsNotEqualOperator) and
                 ( (Stack.Peek(1) is TDomXPathIsEqualExpr) or
                   (Stack.Peek(1) is TDomXPathIsNotEqualExpr) )
              then begin
                // XPath 1.0, prod. [23]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathIsNotEqualExpr.Create(Self, ''); // Create IsNotEqualExpr.
                NewSyntaxNode.Left:= Stack.Pop;                           // Append EqualityExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                     // Append RelationalExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [23]:
                NewSyntaxNode:= TDomXPathIsEqualExpr.Create(Self, ''); // Create IsEqualExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;                   // Append RelationalExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if (LastSyntaxNode is TDomXPathGreaterThanOperator) or
                        (LastSyntaxNode is TDomXPathGreaterThanOrEqualOperator)
            then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if (LastSyntaxNode is TDomXPathIsEqualExpr) or
                        (LastSyntaxNode is TDomXPathIsNotEqualExpr)
            then begin
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_DIV_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MOD_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_PLUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MINUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_IS_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN)
              then begin
                // Operator of higher precedence is following, so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if (Stack.Peek(0) is TDomXPathAndOperator) and
                 ( (Stack.Peek(1) is TDomXPathAndExpr) )
              then begin
                // XPath 1.0, prod. [22]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathAndExpr.Create(Self, ''); // Create AndExpr.
                NewSyntaxNode.Left:= Stack.Pop;                    // Append AndExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;              // Append EqualityExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [22]:
                NewSyntaxNode:= TDomXPathAndExpr.Create(Self, ''); // Create AndExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;               // Append EqualityExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if (LastSyntaxNode is TDomXPathIsEqualOperator) or
                        (LastSyntaxNode is TDomXPathIsNotEqualOperator) or
                        (LastSyntaxNode is TDomXPathLeftParenthesis) or
                        (LastSyntaxNode is TDomXPathLeftSquareBracket) or
                        (LastSyntaxNode is TDomXPathLessThanOperator) or
                        (LastSyntaxNode is TDomXPathLessThanOrEqualOperator)
            then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if LastSyntaxNode is TDomXPathLiteral then begin
              if (Stack.Peek(0) is TDomXPathLeftParenthesis) and
                 (Stack.Peek(1) is TDomXPathNodeTypePI) and
                 Tokenizer.IsFollowing(XPATH_RIGHT_PARENTHESIS_TOKEN)
              then begin
                // Literal is part of a processing-instruction node test,
                // so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end else begin
                // XPath 1.0, prod. [15]:
                NewSyntaxNode:= TDomXPathPrimaryExpr.Create(Self, ''); // Create PrimaryExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;                   // Append Literal.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if (LastSyntaxNode is TDomXPathMinusExpr) or
                        (LastSyntaxNode is TDomXPathPlusExpr)
            then begin
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_DIV_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MOD_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_PLUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MINUS_OPERATOR_TOKEN)
              then begin
                // Operator of higher precedence is following, so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if (Stack.Peek(0) is TDomXPathLessThanOperator) and
                 ( (Stack.Peek(1) is TDomXPathLessThanExpr) or
                   (Stack.Peek(1) is TDomXPathLessThanOrEqualExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanOrEqualExpr) )
              then begin
                // XPath 1.0, prod. [24]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathLessThanExpr.Create(Self, ''); // Create LessThanExpr.
                NewSyntaxNode.Left:= Stack.Pop;                         // Append RelationalExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                   // Append AdditiveExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathLessThanOrEqualOperator) and
                 ( (Stack.Peek(1) is TDomXPathLessThanExpr) or
                   (Stack.Peek(1) is TDomXPathLessThanOrEqualExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanOrEqualExpr) )
              then begin
                // XPath 1.0, prod. [24]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathLessThanOrEqualExpr.Create(Self, ''); // Create LessThanOrEqualExpr.
                NewSyntaxNode.Left:= Stack.Pop;                                // Append RelationalExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                          // Append AdditiveExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathGreaterThanOperator) and
                 ( (Stack.Peek(1) is TDomXPathLessThanExpr) or
                   (Stack.Peek(1) is TDomXPathLessThanOrEqualExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanOrEqualExpr) )
              then begin
                // XPath 1.0, prod. [24]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathGreaterThanExpr.Create(Self, ''); // Create GreaterThanExpr.
                NewSyntaxNode.Left:= Stack.Pop;                            // Append RelationalExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                      // Append AdditiveExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathGreaterThanOrEqualOperator) and
                 ( (Stack.Peek(1) is TDomXPathLessThanExpr) or
                   (Stack.Peek(1) is TDomXPathLessThanOrEqualExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanExpr) or
                   (Stack.Peek(1) is TDomXPathGreaterThanOrEqualExpr) )
              then begin
                // XPath 1.0, prod. [24]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathGreaterThanOrEqualExpr.Create(Self, ''); // Create GreaterThanOrEqualExpr.
                NewSyntaxNode.Left:= Stack.Pop;                                   // Append RelationalExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                             // Append AdditiveExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [24]:
                NewSyntaxNode:= TDomXPathLessThanExpr.Create(Self, ''); // Create LessThanExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;                    // Append AdditiveExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if (LastSyntaxNode is TDomXPathMinusOperator) or
                        (LastSyntaxNode is TDomXPathModOperator) or
                        (LastSyntaxNode is TDomXPathMultiplyOperator)
            then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if LastSyntaxNode is TDomXPathNameTest then begin
              // XPath 1.0, prod. [7]:
              NewSyntaxNode:= TDomXPathNodeTest.Create(Self, '');  // Create NodeTest.
              NewSyntaxNode.Left:= LastSyntaxNode;                 // Append NameTest.
              LastSyntaxNode:= NewSyntaxNode;
            end else if LastSyntaxNode is TDomXPathNodeTest then begin
              // XPath 1.0, prod. [4]:
              if Tokenizer.IsFollowing(XPATH_LEFT_SQUARE_BRACKET_TOKEN) then begin
                // A Predicate is following, so we postpone building the Step.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if Stack.Peek(0) is TDomXPathDoubleColon then begin
                if Stack.Peek(1) is TDomXPathCustomAxisName then begin
                  Stack.Pop.Free;
                  NewSyntaxNode:= Stack.Pop;
                  NewSyntaxNode.Left:= LastSyntaxNode;             // Append NodeTest to AxisName.
                  LastSyntaxNode:= TDomXPathStep.Create(Self, ''); // Create Step.
                  LastSyntaxNode.Left:= NewSyntaxNode;             // Append AxisName to Step.
                end else begin
                  // Malformed XPath Expression.  We are parsing it anyway ...
                  Stack.Push(LastSyntaxNode);
                  Break;
                end;
              end else if Stack.Peek(0) is TDomXPathCommercialAt then begin
                // XPath 1.0, prod. [13]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathAxisNameAttribute.Create(Self, '');
                NewSyntaxNode.Left:= LastSyntaxNode;             // Append NodeTest to AxisName.
                LastSyntaxNode:= TDomXPathStep.Create(Self, ''); // Create Step.
                LastSyntaxNode.Left:= NewSyntaxNode;             // Append AxisName to Step.
              end else begin
                // XPath 1.0, prod. [13]:
                NewSyntaxNode:= TDomXPathAxisNameChild.Create(Self, '');
                NewSyntaxNode.Left:= LastSyntaxNode;             // Append NodeTest to AxisName.
                LastSyntaxNode:= TDomXPathStep.Create(Self, ''); // Create Step.
                LastSyntaxNode.Left:= NewSyntaxNode;             // Append AxisName to Step.
              end;
            end else if (LastSyntaxNode is TDomXPathNodeTypeComment) or
                        (LastSyntaxNode is TDomXPathNodeTypeNode) or
                        (LastSyntaxNode is TDomXPathNodeTypePI) or
                        (LastSyntaxNode is TDomXPathNodeTypeText)
            then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if LastSyntaxNode is TDomXPathNumber then begin
              // XPath 1.0, prod. [15]:
              NewSyntaxNode:= TDomXPathPrimaryExpr.Create(Self, ''); // Create PrimaryExpr.
              NewSyntaxNode.Left:= LastSyntaxNode;                   // Append Number.
              LastSyntaxNode:= NewSyntaxNode;
            end else if LastSyntaxNode is TDomXPathOrExpr then begin
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_DIV_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MOD_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_PLUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_MINUS_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_IS_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_AND_OPERATOR_TOKEN) or
                 Tokenizer.IsFollowing(XPATH_OR_OPERATOR_TOKEN)
              then begin
                // Operator of higher precedence is following, so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              // XPath 1.0, prod. [14]:
              NewSyntaxNode:= TDomXPathExpr.Create(Self, ''); // Create Expr.
              NewSyntaxNode.Left:= LastSyntaxNode;            // Append OrExpr.
              LastSyntaxNode:= NewSyntaxNode;
            end else if LastSyntaxNode is TDomXPathOrOperator then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if LastSyntaxNode is TDomXPathPathExpr then begin
              // XPath 1.0, prod. [18]:
              if Tokenizer.IsFollowing(XPATH_SLASH_OPERATOR_TOKEN) then begin
                // A Slash is following, so we postpone building the TDomXPathUnionExpr.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if (Stack.Peek(0) is TDomXPathShefferStrokeOperator) and
                 (Stack.Peek(1) is TDomXPathUnionExpr)
              then begin
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathUnionExpr.Create(Self, ''); // Create UnionExpr.
                NewSyntaxNode.Left:= Stack.Pop;                      // Append UnionExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                // Append PathExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                NewSyntaxNode:= TDomXPathUnionExpr.Create(Self, ''); // Create UnionExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;                 // Append PathExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if LastSyntaxNode is TDomXPathPlusOperator then begin
              Stack.Push(LastSyntaxNode);
              Break;
            end else if LastSyntaxNode is TDomXPathPredicate then begin
              if Stack.Peek(0) is TDomXPathFilterExpr then begin
                // XPath 1.0, prod. [20]:
                NewSyntaxNode:= TDomXPathFilterExpr.Create(Self, '');
                NewSyntaxNode.Left:= Stack.Pop;
                NewSyntaxNode.Right:= LastSyntaxNode;
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [4]:
                if Tokenizer.IsFollowing(XPATH_LEFT_SQUARE_BRACKET_TOKEN) then begin
                  // Another Predicate is following, so we postpone building the Step.
                  Stack.Push(LastSyntaxNode);
                  Break;
                end;
                if Stack.Peek(0) is TDomXPathPredicate then begin
                  NewSyntaxNode:= Stack.Pop;
                  NewSyntaxNode.Right:= LastSyntaxNode;
                  LastSyntaxNode:= NewSyntaxNode;
                end else if Stack.Peek(0) is TDomXPathNodeTest then begin
                  if Stack.Peek(1) is TDomXPathDoubleColon then begin
                    if Stack.Peek(2) is TDomXPathCustomAxisName then begin
                      NodeTestNode:= Stack.Pop; // Pop the NodeTest from the stack.
                      Stack.Pop.Free;           // Pop and delete the DoubleColon.
                      AxisNode:= Stack.Pop;     // Pop the AxisName from the stack.
                      AxisNode.Left:= NodeTestNode;                    // Append NodeTest to AxisName.
                      AxisNode.Right:= LastSyntaxNode;                 // Append Predicate to AxisName.
                      LastSyntaxNode:= TDomXPathStep.Create(Self, ''); // Create Step.
                      LastSyntaxNode.Left:= AxisNode;                  // Append AxisName to Step.
                    end else begin
                      // Malformed XPath Expression.  We are parsing it anyway ...
                      Stack.Push(LastSyntaxNode);
                      Break;
                    end;
                  end else if Stack.Peek(1) is TDomXPathCommercialAt then begin
                    // XPath 1.0, prod. [13]:
                    NodeTestNode:= Stack.Pop;                               // Pop the NodeTest from the stack.
                    Stack.Pop.Free;                                         // Pop and delete the DoubleColon.
                    AxisNode:= TDomXPathAxisNameAttribute.Create(Self, ''); // Create attribute axis AxisName.
                    AxisNode.Left:= NodeTestNode;                           // Append NodeTest to AxisName.
                    AxisNode.Right:= LastSyntaxNode;                        // Append Predicate to AxisName.
                    LastSyntaxNode:= TDomXPathStep.Create(Self, '');        // Create Step.
                    LastSyntaxNode.Left:= AxisNode;                         // Append AxisName to Step.
                  end else begin
                    // XPath 1.0, prod. [13]:
                    NodeTestNode:= Stack.Pop;                            // Pop the NodeTest from the stack.
                    AxisNode:= TDomXPathAxisNameChild.Create(Self, '');  // Create child axis AxisName.
                    AxisNode.Left:= NodeTestNode;                        // Append NodeTest to AxisName.
                    AxisNode.Right:= LastSyntaxNode;                     // Append Predicate to AxisName.
                    LastSyntaxNode:= TDomXPathStep.Create(Self, '');     // Create Step.
                    LastSyntaxNode.Left:= AxisNode;                      // Append AxisName to Step.
                  end;
                end else begin
                  // Malformed XPath Expression.  We are parsing it anyway ...
                  Stack.Push(LastSyntaxNode);
                  Break;
                end;
              end;
            end else if LastSyntaxNode is TDomXPathPrimaryExpr then begin
              // XPath 1.0, prod. [20]:
              NewSyntaxNode:= TDomXPathFilterExpr.Create(Self, ''); // Create FilterExpr.
              NewSyntaxNode.Left:= LastSyntaxNode;                  // Append PrimaryExpr.
              LastSyntaxNode:= NewSyntaxNode;
            end else if LastSyntaxNode is TDomXPathRightParenthesis then begin
              // XPath 1.0, prod. [7]:
              if (Stack.Peek(0) is TDomXPathLeftParenthesis) and
                 ( (Stack.Peek(1) is TDomXPathNodeTypeComment) or
                   (Stack.Peek(1) is TDomXPathNodeTypeNode) or
                   (Stack.Peek(1) is TDomXPathNodeTypePI) or
                   (Stack.Peek(1) is TDomXPathNodeTypeText) )
              then begin
                LastSyntaxNode.Free;
                LastSyntaxNode:= TDomXPathNodeTest.Create(Self, '');
                Stack.Pop.Free;
                LastSyntaxNode.Left:= Stack.Pop;
              end else if (Stack.Peek(0) is TDomXPathLiteral) and
                          (Stack.Peek(1) is TDomXPathLeftParenthesis) and
                          (Stack.Peek(2) is TDomXPathNodeTypePI)
              then begin
                LastSyntaxNode.Free;
                LastSyntaxNode:= TDomXPathNodeTest.Create(Self, ''); // Create NodeTest
                PILiteral:= Stack.Pop;
                Stack.Pop.Free;                                      // Remove LeftParenthesist from stack.
                nodeTypePI:= Stack.Pop;
                nodeTypePI.Left:= PILiteral;                         // Append Literal to NodeTypePI
                LastSyntaxNode.Left:= nodeTypePI;                    // Append NodeTypePI to NodeTest
              end else if (Stack.Peek(0) is TDomXPathExpr) and
                          (Stack.Peek(1) is TDomXPathLeftParenthesis) and not
                          (Stack.Peek(2) is TDomXPathFunctionName)
              then begin
                LastSyntaxNode.Free;
                NewSyntaxNode:= TDomXPathPrimaryExpr.Create(Self, ''); // Create PrimaryExpr.
                NewSyntaxNode.Left:= Stack.Pop;                        // Append Expr.
                Stack.Pop.Free;                                        // Remove LeftParenthesis from stack.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [16]:
                functionCallNode:= TDomXPathFunctionCall.Create(Self, ''); // Create FunctionCall.
                while Stack.Peek(0) is TDomXPathExpr do begin
                  functionCallNode.Arguments.Insert(0, Stack.Pop); // Add Expr as first argument to FunctionCall.
                  if Stack.Peek(0) is TDomXPathComma then begin
                    Stack.Pop.Free                                 // Remove Comma from stack.
                  end else if not (Stack.Peek(0) is TDomXPathLeftParenthesis) then begin
                    // Malformed XPath Expression.  We are parsing it anyway ...
                    Break;
                  end;
                end;
                if (Stack.Peek(0) is TDomXPathLeftParenthesis) and
                   (Stack.Peek(1) is TDomXPathFunctionName)
                then begin
                  // XPath 1.0, prod. [15]:
                  LastSyntaxNode.Free;
                  Stack.Pop.Free;                                        // Remove LeftParenthesis from stack.
                  functionCallNode.functionName := Stack.Peek(0).Value;  // Set function name on FunctionCallNode.
                  Stack.Pop.Free;                                        // Remove FunctionName.
                  NewSyntaxNode:= TDomXPathPrimaryExpr.Create(Self, ''); // Create PrimaryExpr.
                  NewSyntaxNode.Left:= functionCallNode;                 // Append FunctionCall.
                  LastSyntaxNode:= NewSyntaxNode;
                end else begin
                  // Malformed XPath Expression.  We are parsing it anyway ...
                  Stack.Push(functionCallNode);
                  Stack.Push(LastSyntaxNode);
                  Break;
                end;
              end;
            end else if LastSyntaxNode is TDomXPathRightSquareBracket then begin
              // XPath 1.0, prod. [8] and [9]:
              if (Stack.Peek(0) is TDomXPathExpr) and
                 (Stack.Peek(1) is TDomXPathLeftSquareBracket)
              then begin
                LastSyntaxNode.Free;
                LastSyntaxNode:= TDomXPathPredicate.Create(Self, ''); // Create Predicate.
                LastSyntaxNode.Left:= Stack.Pop;                      // Append Expr.
                Stack.Pop.Free;                                       // Remove LeftSquareBracket from stack.
              end else begin
                // Malformed XPath Expression.  We are parsing it anyway ...
                Stack.Push(LastSyntaxNode);
                Break;
              end;
            end else if LastSyntaxNode is TDomXPathShefferStrokeOperator then begin
              if Stack.Peek(0) is TDomXPathPathExpr then begin
                NewSyntaxNode:= TDomXPathUnionExpr.Create(Self, ''); // Create UnionExpr.
                NewSyntaxNode.Left:= Stack.Pop;                      // Append PathExpr from stack.
                Stack.Push(NewSyntaxNode);                           // Push the UnionExpr on the stack.
                Stack.Push(LastSyntaxNode);                          // Push the ShefferStrokeOperator on the stack.
                Break;
              end else begin
                // Malformed XPath Expression.  We are parsing it anyway ...
                Stack.Push(LastSyntaxNode);
                Break;
              end;
            end else if LastSyntaxNode is TDomXPathSingleDot then begin
              // XPath 1.0, prod. [12]:
              LastSyntaxNode.Free;
              LastSyntaxNode:= TDomXPathStep.Create(Self, '');                        // Create Step.
              LastSyntaxNode.Left:= TDomXPathAxisNameSelf.Create(Self, '');           // Create and append AxisName to Step.
              LastSyntaxNode.Left.Left:= TDomXPathNodeTest.Create(Self, '');          // Create and append NodeTest to AxisName.
              LastSyntaxNode.Left.Left.Left:= TDomXPathNodeTypeNode.Create(Self, ''); // Create and append NodeType to NodeTest.
            end else if LastSyntaxNode is TDomXPathSlashOperator then begin
              // XPath 1.0, prod. [2]:
              if ( (not Assigned(Stack.Peek(0))) or
                   (Stack.Peek(0) is TDomXPathShefferStrokeOperator) ) and
                 ( Tokenizer.IsFollowing(XPATH_END_OF_TEXT_TOKEN) or
                   Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN)    )
              then begin
                LastSyntaxNode.Free;
                LastSyntaxNode:= TDomXPathPathExpr.Create(Self, '');                  // Create PathExpr.
                LastSyntaxNode.Left:= TDomXPathAbsoluteLocationPath.Create(Self, ''); // Create and append AbsolutLocationPath.
              end else begin
                Stack.Push(LastSyntaxNode);
                Break;
              end;
            end else if LastSyntaxNode is TDomXPathStep then begin
              // XPath 1.0, prod. [3] and [19]:
              if Stack.Peek(0) is TDomXPathSlashOperator then begin
                if Stack.Peek(1) is TDomXPathFilterExpr then begin
                  Stack.Pop.Free;
                  NewSyntaxNode:= TDomXPathPathExpr.Create(Self, ''); // Create PathExpr.
                  NewSyntaxNode.Left:= Stack.Pop;                     // Append FilterExpr to PathExpr.
                  NewSyntaxNode.Right:= LastSyntaxNode;               // Append Step to PathExpr.
                  LastSyntaxNode:= NewSyntaxNode;
                end else if Stack.Peek(1) is TDomXPathPathExpr then begin
                  Stack.Pop.Free;
                  if TDomXPathPathExpr(Stack.Peek(0)).AddStep(TDomXPathStep(LastSyntaxNode)) then begin
                    LastSyntaxNode:= Stack.Pop;
                  end else begin
                    // Malformed XPath Expression.  We are parsing it anyway ...
                    Stack.Push(LastSyntaxNode);
                    Break;
                  end;
                end else if (not Assigned(Stack.Peek(1)) ) or
                            (Stack.Peek(1) is TDomXPathShefferStrokeOperator) or
                            (Stack.Peek(1) is TDomXPathLeftParenthesis)  
                then begin
                  // XPath 1.0, prod. [2]:
                  Stack.Pop.Free;
                  NewSyntaxNode:= TDomXPathPathExpr.Create(Self, '');                  // Create PathExpr.
                  NewSyntaxNode.Left:= TDomXPathAbsoluteLocationPath.Create(Self, ''); // Create and append AbsolutLocationPath.
                  NewSyntaxNode.Right:= LastSyntaxNode;                                // Append Step.
                  LastSyntaxNode:= NewSyntaxNode;
                end else begin
                  // Malformed XPath Expression.  We are parsing it anyway ...
                  Stack.Push(LastSyntaxNode);
                  Break;
                end;
              end else begin
                NewSyntaxNode:= TDomXPathPathExpr.Create(Self, ''); // Create PathExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;               // Append Step to PathExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if LastSyntaxNode is TDomXPathUnaryExpr then begin
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) then begin
                // Operator of higher precedence is following, so we postpone building the expression.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              if (Stack.Peek(0) is TDomXPathMinusOperator) and not (
                   (Stack.Peek(1) is TDomXPathPlusExpr) or
                   (Stack.Peek(1) is TDomXPathMinusExpr) or
                   (Stack.Peek(1) is TDomXPathMultiplyExpr) or
                   (Stack.Peek(1) is TDomXPathDivExpr) or
                   (Stack.Peek(1) is TDomXPathModExpr) or
                   (Stack.Peek(1) is TDomXPathUnaryExpr) or
                   (Stack.Peek(1) is TDomXPathUnionExpr)  )
              then begin
                // XPath 1.0, prod. [27]:
                NewSyntaxNode:= TDomXPathUnaryExpr.Create(Self, ''); // Create UnaryExpr.
                NewSyntaxNode.Left:= Stack.Pop;                      // Append MinusOperator.
                NewSyntaxNode.Right:= LastSyntaxNode;                // Append UnaryExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathMultiplyOperator) and
                 ( (Stack.Peek(1) is TDomXPathMultiplyExpr) or
                   (Stack.Peek(1) is TDomXPathDivExpr) or
                   (Stack.Peek(1) is TDomXPathModExpr) )
              then begin
                // XPath 1.0, prod. [26]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathMultiplyExpr.Create(Self, ''); // Create MultiplyExpr.
                NewSyntaxNode.Left:= Stack.Pop;                         // Append MultiplicativeExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;                   // Append UnaryExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathDivOperator) and
                 ( (Stack.Peek(1) is TDomXPathMultiplyExpr) or
                   (Stack.Peek(1) is TDomXPathDivExpr) or
                   (Stack.Peek(1) is TDomXPathModExpr) )
              then begin
                // XPath 1.0, prod. [26]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathDivExpr.Create(Self, ''); // Create DivExpr.
                NewSyntaxNode.Left:= Stack.Pop;                    // Append MultiplicativeExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;              // Append UnaryExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else if (Stack.Peek(0) is TDomXPathModOperator) and
                 ( (Stack.Peek(1) is TDomXPathMultiplyExpr) or
                   (Stack.Peek(1) is TDomXPathDivExpr) or
                   (Stack.Peek(1) is TDomXPathModExpr) )
              then begin
                // XPath 1.0, prod. [26]:
                Stack.Pop.Free;
                NewSyntaxNode:= TDomXPathModExpr.Create(Self, ''); // Create ModExpr.
                NewSyntaxNode.Left:= Stack.Pop;                    // Append MultiplicativeExpr.
                NewSyntaxNode.Right:= LastSyntaxNode;              // Append UnaryExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end else begin
                // XPath 1.0, prod. [26]:
                NewSyntaxNode:= TDomXPathMultiplyExpr.Create(Self, ''); // Create MultiplyExpr.
                NewSyntaxNode.Left:= LastSyntaxNode;                    // Append UnaryExpr.
                LastSyntaxNode:= NewSyntaxNode;
              end;
            end else if LastSyntaxNode is TDomXPathUnionExpr then begin
              // XPath 1.0, prod. [27]:
              if Tokenizer.IsFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) then begin
                // A Sheffer's Stroke is following, so we postpone building the UnaryExpr.
                Stack.Push(LastSyntaxNode);
                Break;
              end;
              NewSyntaxNode:= TDomXPathUnaryExpr.Create(Self, ''); // Create UnaryExpr.
              NewSyntaxNode.Left:= LastSyntaxNode;                 // Append the UnionExpr.
              LastSyntaxNode:= NewSyntaxNode;
            end else if LastSyntaxNode is TDomXPathVariableReference then begin
              // XPath 1.0, prod. [15]:
              NewSyntaxNode:= TDomXPathPrimaryExpr.Create(Self, ''); // Create PrimaryExpr.
              NewSyntaxNode.Left:= LastSyntaxNode;                   // Append VariableReference.
              LastSyntaxNode:= NewSyntaxNode;
            end;
          until False;
        end; {case ... else ...}
      until False;

      // Is the syntax tree valid, I.e. does the evaluation reach the end of the text
      // and does the stack hold exactly one root node of type TDomXPathExpr?
      if (Symbol =  XPATH_END_OF_TEXT_TOKEN) and
         (Stack.Length = 1) and
         (Stack.Peek(0) is TDomXPathExpr)
      then begin
        FRootExpr := TDomXPathExpr(Stack.Pop);
        Result := True;
      end else Result := False;

    finally
      Stack.Free; // Remark: Frees also all object still in the stack.
    end;
  finally
    Tokenizer.Free;
  end;
end;

function TDomXPathSyntaxTree.GetContextNode: TDomNode;
begin
  if Assigned(OwnerXPathExpression)
    then Result := OwnerXPathExpression.ContextNode
    else Result := nil;
end;

function TDomXPathSyntaxTree.LookupNamespaceURI(const APrefix: WideString): WideString;
begin
  if Assigned(OwnerXPathExpression)
    then Result := OwnerXPathExpression.LookupNamespaceURI(APrefix)
    else Result := '';
end;

{ TXPathExpression }

constructor TXPathExpression.Create(AOwner: TComponent);
begin
  inherited;
  FIsValid:= T_UNKNOWN;
  FSyntaxTree:= TDomXPathSyntaxTree.Create(Self);
end;

destructor TXPathExpression.Destroy;
begin
  FXPathResult.Free;
  FSyntaxTree.Free;
  inherited;
end;

function TXPathExpression.AcquireXPathResult(const ResultType: TDomXPathResultClass): TDomXPathCustomResult;
begin
  if ResultType = TDomXPathNodeSetResult then begin
    Result := TDomXPathNodeSetResult.Create;
    Result.Assign(Self);
  end else if ResultType = TDomXPathBooleanResult then begin
    Result := TDomXPathBooleanResult.Create(resultAsBoolean);
  end else if ResultType = TDomXPathNumberResult then begin
    Result := TDomXPathNumberResult.Create(resultAsNumber);
  end else if ResultType = TDomXPathStringResult then begin
    Result := TDomXPathStringResult.Create(resultAsWideString);
  end else raise ENot_Supported_Err.Create('Not supported error.');
end;

function TXPathExpression.Evaluate: Boolean;
begin
  FXPathResult.Free;
  FXPathResult := nil;
  try
    Result := Prepare;
    if Result then
      FXPathResult := FSyntaxTree.Evaluate;
  except
    Result := False;
    FXPathResult.Free;
    FXPathResult := nil;
  end;
end;

function TXPathExpression.HasNodeSetResult: Boolean;
begin
  if Assigned(FXPathResult)
    then Result := FXPathResult.Length > 0
    else Result := False;
end;

function TXPathExpression.LookupNamespaceURI(const APrefix: WideString): WideString;
begin
  if Assigned(ContextNode)
    then Result := ContextNode.LookupNamespaceURI(APrefix)
    else Result := '';
  if Assigned(FOnLookupNamespaceURI) then
    FOnLookupNamespaceURI(Self, APrefix, Result);
end;

function TXPathExpression.Prepare: Boolean;
begin
  if isValid = T_UNKNOWN then begin
    Result := FSyntaxTree.Prepare(FExpression);
    if Result
      then FIsValid:= T_TRUE
      else FIsValid:= T_FALSE;
  end else Result := FIsValid = T_TRUE;
end;

function TXPathExpression.ResultAsBoolean: Boolean;
begin
  if Assigned(FXPathResult)
    then Result := FXPathResult.AsBoolean
    else Result := False;
end;

function TXPathExpression.ResultAsNumber: Double;
begin
  if Assigned(FXPathResult)
    then Result := FXPathResult.AsNumber
    else Result := NaN;
end;

function TXPathExpression.ResultAsWideString: WideString;
begin
  if Assigned(FXPathResult)
    then Result := FXPathResult.AsWideString
    else Result := '';
end;

function TXPathExpression.ResultAxisType: TDomXPathAxisType;
begin
  if Assigned(FXPathResult)
    then Result := FXPathResult.AxisType
    else Result := XPATH_FORWARD_AXIS;
end;

function TXPathExpression.ResultLength: Integer;
begin
  if Assigned(FXPathResult)
    then Result := FXPathResult.Length
    else Result := 0;
end;

function TXPathExpression.ResultNode(const Index: Integer): TDomNode;
begin
  if Assigned(FXPathResult)
    then Result := FXPathResult.Item(Index)
    else Result := nil;
end;

procedure TXPathExpression.SetContextNode(const Node: TDomNode);
begin
  if Assigned(Node) then
    if not (Node.RootDocument is TDomDocumentXPath) then
      raise ENot_Supported_Err.Create('Not supported error.');

  FContextNode := Node;
end;

procedure TXPathExpression.SetExpression(const S: WideString);
begin
  if S <> FExpression then begin
    FExpression:= S;
    FSyntaxTree.Clear;
    FIsValid:= T_UNKNOWN;
  end;
end;

{ TDomXPathSyntaxNodeStack }

constructor TDomXPathSyntaxNodeStack.Create;
begin
  inherited;
  FNodeList:= TList.Create;
end;

destructor TDomXPathSyntaxNodeStack.Destroy;
begin
  Clear;
  FNodeList.Free;
  inherited;
end;

procedure TDomXPathSyntaxNodeStack.Clear;
var
  I: Integer;
begin
  for I := 0 to Pred(FNodeList.Count) do
    TDomXPathSyntaxNode(FNodeList[I]).Free;
end;

function TDomXPathSyntaxNodeStack.GetLength: Integer;
begin
  Result := FNodeList.Count;
end;

function TDomXPathSyntaxNodeStack.Peek(Offset: Integer): TDomXPathSyntaxNode;
var
  Index: Integer;
begin
  Index := Pred(FNodeList.Count) - Offset;
  if (Index < 0) or (Index >= FNodeList.Count)
    then Result := nil
    else Result := TDomXPathSyntaxNode(FNodeList.List^[Index]);
end;

function TDomXPathSyntaxNodeStack.Pop: TDomXPathSyntaxNode;
begin
  Result := FNodeList[Pred(FNodeList.Count)];
  FNodeList.Delete(Pred(FNodeList.Count));
end;

function TDomXPathSyntaxNodeStack.Push(Node: TDomXPathSyntaxNode): TDomXPathSyntaxNode;
begin
  Result := TDomXPathSyntaxNode(FNodeList.Add(Node));
end;

{ TDomXPathSyntaxNode }

constructor TDomXPathSyntaxNode.Create(const AOwner: TDomXPathSyntaxTree;
                                       const Value: WideString);
begin
  inherited Create(AOwner);
  FLeft:= nil;
  FRight:= nil;
  FValue := Value;
end;

function TDomXPathSyntaxNode.GetOwnerSyntaxTree: TDomXPathSyntaxTree;
begin
  Result := (GetOwner as TDomXPathSyntaxTree);
end;

function TDomXPathSyntaxNode.LookupNamespaceURI(const APrefix: WideString): WideString;
begin
  if Assigned(OwnerSyntaxTree)
    then Result := OwnerSyntaxTree.LookupNamespaceURI(APrefix)
    else Result := '';
end;

{ TDomXPathStep }

function TDomXPathStep.AddStep(const Step: TDomXPathStep): Boolean;
begin
  if not Assigned(Right) then begin
    Right:= Step;
    Result := True;
  end else begin
    if Right is TDomXPathStep
      then Result := TDomXPathStep(Right).AddStep(Step)
      else Result := False;
  end;
end;

function TDomXPathStep.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
var
  NewResult: TDomXPathNodeSetResult;
begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');
  if Left is TDomXPathCustomAxisName then begin

    if OldSnapshotResult.Length > 0 then begin
      NewResult := TDomXPathCustomAxisName(Left).Evaluate(OldSnapshotResult);
      if Right is TDomXPathStep
        then Result := TDomXPathStep(Right).Evaluate(NewResult)
        else Result := NewResult;
    end else Result := OldSnapshotResult;

  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathCustomAxisName }

constructor TDomXPathCustomAxisName.Create(const AOwner: TDomXPathSyntaxTree;
                                           const Value: WideString);
begin
  inherited;
  FAxisType := XPATH_FORWARD_AXIS;
  FPrincipalNodeType := ntElement_Node;
end;

function TDomXPathCustomAxisName.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
var
  I: Integer;
  N: TDomNode;
  AxisNodeSnapshot, InputSnapshot, NodeTestSnapshot: TDomXPathNodeSetResult;

  function EvaluatePredicate(const snapshot: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
  begin
    if Assigned(Right) then begin
      if Right is TDomXPathPredicate then begin
        if snapshot.Length > 0
          then Result := TDomXPathPredicate(Right).Evaluate(snapshot)
          else Result := snapshot;
      end else begin
        snapshot.Free;
        raise EXPath_Type_Err.Create('XPath type error.');
      end;
    end else Result := snapshot;
  end;

  function EvaluateNodeTest(const snapshot: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
  begin
    if Assigned(Left) then begin
      if Left is TDomXPathNodeTest then begin
        if snapshot.Length > 0
          then Result := TDomXPathNodeTest(Left).Evaluate(snapshot,FPrincipalNodeType)
          else Result := snapshot;
      end else begin
        snapshot.Free;
        raise EXPath_Type_Err.Create('XPath type error.');
      end;
    end else raise EXPath_Type_Err.Create('XPath type error.');
  end;

begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');
  try
    Result := TDomXPathNodeSetResult.Create;
    try
      Result.AxisType := AxisType;
      with OldSnapshotResult do begin
        for I := 0 to Pred(Length) do begin
          N := Item(I);
          if Assigned(N) then begin
            InputSnapshot:= GetAxisNodeSnapshot(N);
            NodeTestSnapshot:= EvaluateNodeTest(InputSnapshot);
            AxisNodeSnapshot:= EvaluatePredicate(NodeTestSnapshot);
            try
              Result.Merge(AxisNodeSnapshot);
            finally
              AxisNodeSnapshot.Free;
            end;
          end;
        end;
      end;
    except
      Result.Free;
      raise;
    end;
  finally
    OldSnapshotResult.Free;
  end;
end;

{ TDomXPathAxisNameAncestor }

constructor TDomXPathAxisNameAncestor.Create(const AOwner: TDomXPathSyntaxTree;
                                             const Value: WideString);
begin
  inherited;
  FAxisType := XPATH_REVERSE_AXIS;
end;

function TDomXPathAxisNameAncestor.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  N: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    case ContextNode.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node:
        N := ContextNode.ParentNode;
      ntAttribute_Node:
        N := TDomAttr(ContextNode).OwnerElement;
      ntXPath_Namespace_Node:
        N := TDomXPathNamespace(ContextNode).OwnerElement;
    else
      N := nil;
    end;
    while Assigned(N) do begin
      Result.Add(N);
      N := N.ParentNode;
    end;
  end;
end;

{ TDomXPathAxisNameAncestorOrSelf }

constructor TDomXPathAxisNameAncestorOrSelf.Create(const AOwner: TDomXPathSyntaxTree;
                                                   const Value: WideString);
begin
  inherited;
  FAxisType := XPATH_REVERSE_AXIS;
end;

function TDomXPathAxisNameAncestorOrSelf.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  N: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    Result.Add(ContextNode);
    case ContextNode.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node:
        N := ContextNode.ParentNode;
      ntAttribute_Node:
        N := TDomAttr(ContextNode).OwnerElement;
      ntXPath_Namespace_Node:
        N := TDomXPathNamespace(ContextNode).OwnerElement;
    else
      N := nil;
    end;
    while Assigned(N) do begin
      Result.Add(N);
      N := N.ParentNode;
    end;
  end;
end;

{ TDomXPathAxisNameAttribute }

constructor TDomXPathAxisNameAttribute.Create(const AOwner: TDomXPathSyntaxTree;
                                              const Value: WideString);
begin
  inherited;
  FPrincipalNodeType := ntAttribute_Node;
end;

function TDomXPathAxisNameAttribute.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  I: Integer;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then
    with ContextNode do
      if NodeType = ntElement_Node then
        with Attributes do
          for I := 0 to Pred(Length) do
            if (Item(I) as TDomAttr).IsXmlnsDecl = NSDT_NONE then
              Result.Add(Item(I));
end;

{ TDomXPathAxisNameChild }

function TDomXPathAxisNameChild.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  I: Integer;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then
    with ContextNode.ChildNodes do
      for I := 0 to Pred(Length) do
        Result.Add(Item(I));
end;

{ TDomXPathAxisNameDescendant }

function TDomXPathAxisNameDescendant.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  N: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    with ContextNode.RootDocument.CreateNodeIterator(ContextNode,
                                                      [ ntElement_Node,
                                                        ntText_Node,
                                                        ntCDATA_Section_Node,
                                                        ntEntity_Reference_Node,
                                                        ntProcessing_Instruction_Node,
                                                        ntComment_Node ],
                                                      nil,
                                                      False) do begin
      N := NextNode;
      if N = ContextNode then N := NextNode;
      while Assigned(N) do begin
        Result.Add(N);
        N := NextNode;
      end;
      Detach;
    end;
    ContextNode.RootDocument.ClearInvalidNodeIterators;
  end;
end;

{ TDomXPathAxisNameDescendantOrSelf }

function TDomXPathAxisNameDescendantOrSelf.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  N: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    with ContextNode.RootDocument.CreateNodeIterator(ContextNode,
                                                      [ ntElement_Node,
                                                        ntText_Node,
                                                        ntCDATA_Section_Node,
                                                        ntEntity_Reference_Node,
                                                        ntProcessing_Instruction_Node,
                                                        ntComment_Node,
                                                        ntDocument_Node ],
                                                      nil,
                                                      False) do begin
      N := NextNode;
      while Assigned(N) do begin
        Result.Add(N);
        N := NextNode;
      end;
      Detach;
    end;
    ContextNode.RootDocument.ClearInvalidNodeIterators;
  end;
end;

{ TDomXPathAxisNameFollowing }

function TDomXPathAxisNameFollowing.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  P, Q: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    case ContextNode.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node: begin
        Q := ContextNode;
        P := ContextNode.NextSibling;
        while Assigned(P) do begin
          if not ( ( (Q.NodeType = ntText_Node) or
                     (Q.NodeType = ntCDATA_Section_Node) or
                     (Q.NodeType = ntEntity_Reference_Node) ) and
                   ( (P.NodeType = ntText_Node) or
                     (P.NodeType = ntCDATA_Section_Node) or
                     (P.NodeType = ntEntity_Reference_Node) ) )
          then Result.AddSubtree(P);
          Q := P;
          P.NextSibling;
        end;
      end;
    end;
  end;
end;

{ TDomXPathAxisNameFollowingSibling }

function TDomXPathAxisNameFollowingSibling.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  P, Q: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    case ContextNode.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node: begin
        Q := ContextNode;
        P := ContextNode.NextSibling;
        while Assigned(P) do begin
          if not ( ( (Q.NodeType = ntText_Node) or
                     (Q.NodeType = ntCDATA_Section_Node) or
                     (Q.NodeType = ntEntity_Reference_Node) ) and
                   ( (P.NodeType = ntText_Node) or
                     (P.NodeType = ntCDATA_Section_Node) or
                     (P.NodeType = ntEntity_Reference_Node) ) )
          then Result.Add(P);
          Q := P;
          P := Q.NextSibling;
        end;
      end;
    end;
  end;
end;

{ TDomXPathAxisNameNamespace }

constructor TDomXPathAxisNameNamespace.Create(const AOwner: TDomXPathSyntaxTree;
                                              const Value: WideString);
begin
  inherited;
  FPrincipalNodeType := ntXPath_Namespace_Node;
end;

function TDomXPathAxisNameNamespace.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  PrefixUriList: TUtilsNameValueList;
  CNode: TDomNode;
  I: Integer;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;

  if ContextNode.NodeType = ntElement_Node then begin
    PrefixUriList:= TUtilsNameValueList.Create;
    try
      with PrefixUriList do begin
        Sorted := True;
        Duplicates := dupIgnore;
        Add('xml', 'http://www.w3.org/XML/1998/namespace');
        Add('xmlns', 'http://www.w3.org/2000/xmlns/'); 
      end;

      CNode := ContextNode;
      while Assigned(CNode) do begin
        if CNode.NodeType <> ntElement_Node then Break;
        with CNode.Attributes do
          for I := 0 to Pred(Length) do
            with TDomAttr(Item(I)) do
              case IsXmlnsDecl of
                NSDT_DEFAULT: PrefixUriList.Add('', NodeValue);
                NSDT_PREFIXED: PrefixUriList.Add(LocalName, NodeValue);
              end;
        CNode:= CNode.ParentNode;
      end;

      with PrefixUriList do
        for I := 0 to Pred(Length) do
          Result.AddXPathNamespace(ContextNode as TDomElement, Values[I], Names[I]);

    finally
      PrefixUriList.Free;
    end;
  end;
end;

{ TDomXPathAxisNameParent }

function TDomXPathAxisNameParent.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  N: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    case ContextNode.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node:
        N := ContextNode.ParentNode;
      ntAttribute_Node:
        N := TDomAttr(ContextNode).OwnerElement;
      ntXPath_Namespace_Node:
        N := TDomXPathNamespace(ContextNode).OwnerElement;
    else
      N := nil;
    end;
    if Assigned(N)
      then Result.Add(N);
  end;
end;

{ TDomXPathAxisNamePreceding }

constructor TDomXPathAxisNamePreceding.Create(const AOwner: TDomXPathSyntaxTree;
                                              const Value: WideString);
begin
  inherited;
  FAxisType := XPATH_REVERSE_AXIS;
end;

function TDomXPathAxisNamePreceding.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  N: TDomNode;

  procedure AddPreceding(const Snapshot: TDomXPathNodeSetResult;
                         const Node: TDomNode);
  var
    P, Q: TDomNode;
  begin
    case Node.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node: begin
        P := Node.PreviousSibling;
        while Assigned(P) do begin
          Q := P.PreviousSibling;
          if Assigned(Q) then begin
            if not ( ( (P.NodeType = ntText_Node) or
                       (P.NodeType = ntCDATA_Section_Node) or
                       (P.NodeType = ntEntity_Reference_Node) ) and
                     ( (Q.NodeType = ntText_Node) or
                       (Q.NodeType = ntCDATA_Section_Node) or
                       (Q.NodeType = ntEntity_Reference_Node) ) )
            then snapshot.AddSubtree(P);
            P := Q;
          end else begin
            snapshot.AddSubtree(P);
            Break;
          end;
        end;
      end;
    end;
  end;

begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    AddPreceding(Result,ContextNode);
    case ContextNode.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node:
        N := ContextNode.ParentNode;
      ntAttribute_Node:
        N := TDomAttr(ContextNode).OwnerElement;
      ntXPath_Namespace_Node:
        N := TDomXPathNamespace(ContextNode).OwnerElement;
    else
      N := nil;
    end;
    while Assigned(N) do begin
      AddPreceding(Result,N);
      N := N.ParentNode;
    end;
  end;
end;

{ TDomXPathAxisNamePrecedingSibling }

constructor TDomXPathAxisNamePrecedingSibling.Create(const AOwner: TDomXPathSyntaxTree;
                                                     const Value: WideString);
begin
  inherited;
  FAxisType := XPATH_REVERSE_AXIS;
end;

function TDomXPathAxisNamePrecedingSibling.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
var
  P, Q: TDomNode;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode) then begin
    case ContextNode.NodeType of
      ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node,
      ntProcessing_Instruction_Node, ntComment_Node: begin
        P := ContextNode.PreviousSibling;
        while Assigned(P) do begin
          Q := P.PreviousSibling;
          if Assigned(Q) then begin
            if not ( ( (P.NodeType = ntText_Node) or
                       (P.NodeType = ntCDATA_Section_Node) or
                       (P.NodeType = ntEntity_Reference_Node) ) and
                     ( (Q.NodeType = ntText_Node) or
                       (Q.NodeType = ntCDATA_Section_Node) or
                       (Q.NodeType = ntEntity_Reference_Node) ) )
            then Result.Add(P);
            P := Q;
          end else begin
            Result.Add(P);
            Break;
          end;
        end;
      end;
    end;
  end;
end;

{ TDomXPathAxisNameSelf }

function TDomXPathAxisNameSelf.GetAxisNodeSnapshot(const ContextNode: TDomNode): TDomXPathNodeSetResult;
begin
  Result := TDomXPathNodeSetResult.Create;
  Result.AxisType := AxisType;
  if Assigned(ContextNode)
    then Result.Add(ContextNode);
end;

{ TDomXPathNodeTest }

function TDomXPathNodeTest.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult;
                                    const PrincipalNodeType: TDomNodeType): TDomXPathNodeSetResult;
begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');

  if Left is TDomXPathNameTest then begin
    Result := TDomXPathNameTest(Left).Evaluate(OldSnapshotResult,principalNodeType);
  end else if Left is TDomXPathNodeTypeComment then begin
    Result := TDomXPathNodeTypeComment(Left).Evaluate(OldSnapshotResult);
  end else if Left is TDomXPathNodeTypeText then begin
    Result := TDomXPathNodeTypeText(Left).Evaluate(OldSnapshotResult);
  end else if Left is TDomXPathNodeTypePI then begin
    Result := TDomXPathNodeTypePI(Left).Evaluate(OldSnapshotResult);
  end else if Left is TDomXPathNodeTypeNode then begin
    Result := OldSnapshotResult;
  end else begin
    OldSnapshotResult.Free;
    raise EXPath_Type_Err.Create('XPath type error.');
  end;
end;

{ TDomXPathPredicate }

function TDomXPathPredicate.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
var
  ContextNode: TDomNode;
  NextPredicateResult: TDomXPathNodeSetResult;
  PredicateResult: TDomXPathCustomResult;
  PredicateResultAsBoolean: TDomXPathBooleanResult;
  ContextPosition: Integer;
begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');
  if not (Left is TDomXPathExpr) then begin
    OldSnapshotResult.Free;
    raise EXPath_Type_Err.Create('XPath type error.');
  end;

  try
    Result := TDomXPathNodeSetResult.Create;
    Result.AxisType := OldSnapshotResult.AxisType;
    with OldSnapshotResult do begin
      for ContextPosition:= 1 to Length do begin
        ContextNode:= Item(Pred(ContextPosition));
        try
          PredicateResult := TDomXPathExpr(Left).Evaluate(ContextNode, ContextPosition, Length);
          if PredicateResult is TDomXPathNumberResult then begin
            if PredicateResult.AsNumber = ContextPosition then
              Result.Add(ContextNode);
            PredicateResult.Free;
          end else begin
            PredicateResultAsBoolean:= XPathBooleanFunc(PredicateResult);
            if PredicateResultAsBoolean.AsBoolean then
              Result.Add(ContextNode);
            PredicateResultAsBoolean.Free;
          end;
        except
          Result.Free;
          raise;
        end;
      end;
    end;

    if Assigned(Right) then begin
      if Right is TDomXPathPredicate then begin
        NextPredicateResult := TDomXPathPredicate(Right).Evaluate(Result);
        Result := NextPredicateResult;
      end else begin
        Result.Free;
        raise EXPath_Type_Err.Create('XPath type error.');
      end;
    end;

  finally
    OldSnapshotResult.Free;
  end;
end;

{ TDomXPathExpr }

function TDomXPathExpr.Evaluate(const ContextNode: TDomNode;
                                const ContextPosition,
                                      ContextSize: Integer): TDomXPathCustomResult;
begin
  if (Left is TDomXPathOrExpr) then begin
    Result := TDomXPathOrExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathPrimaryExpr }

function TDomXPathPrimaryExpr.Evaluate(const ContextNode: TDomNode;
                                       const ContextPosition,
                                             ContextSize: Integer): TDomXPathCustomResult;
begin
  if (Left is TDomXPathVariableReference) then begin
    Result := TDomXPathVariableReference(Left).Evaluate;
  end else if (Left is TDomXPathExpr) then begin
    Result := TDomXPathExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else if (Left is TDomXPathLiteral) then begin
    Result := TDomXPathLiteral(Left).Evaluate;
  end else if (Left is TDomXPathNumber) then begin
    Result := TDomXPathNumber(Left).Evaluate;
  end else if (Left is TDomXPathFunctionCall) then begin
    Result := TDomXPathFunctionCall(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathFunctionCall }

constructor TDomXPathFunctionCall.Create(const AOwner: TDomXPathSyntaxTree;
                                         const Value: WideString);
begin
  inherited;
  FArguments:= TList.Create;
end;

destructor TDomXPathFunctionCall.Destroy;
begin
  FArguments.Free;
  inherited;
end;

function TDomXPathFunctionCall.Evaluate(const ContextNode: TDomNode;
                                        const ContextPosition: Integer;
                                        const ContextSize: Integer): TDomXPathCustomResult;
var
  NsUri: WideString;
begin
  if Assigned(FXPathFunction) then begin
    Result := FXPathFunction(ContextNode, ContextPosition, ContextSize, Arguments);
  end else begin
    Result := nil;
    // Determine Namespace URI
    NsUri := LookupNamespaceURI(FPrefix);
    if (NsUri = '') and (FPrefix <> '') then
      raise ENamespace_Err.CreateFmt('Namespace URI of prefix ''%S'' not found.',
                                     [FPrefix]);

    if Assigned(OwnerSyntaxTree) then with OwnerSyntaxTree do
      if Assigned(ContextNode) then with ContextNode do
        if Assigned(OwnerDocument) then with OwnerDocument do
          if Assigned(DomImplementation) then
            DomImplementation.DoRequestXPathFunctionResult(
              NsUri, FLocalName, ContextNode, ContextPosition, ContextSize, Arguments, Result
            );

    if not Assigned(Result) then
      raise EXPath_Exception.Create('Unknown function name.');
  end;
end;

function TDomXPathFunctionCall.GetFunctionName: WideString;
begin
  Result := FValue;
end;

procedure TDomXPathFunctionCall.SetFunctionName(const AFunctionName: WideString);
begin
  if AFunctionName <> FValue then begin
    FValue := AFunctionName;
    FPrefix := XmlExtractPrefix(Value);
    FLocalName := XmlExtractLocalName(Value);
    if FPrefix = '' then begin
      if FLocalName = 'last' then begin
        FXPathFunction := XPathFunctionLast;
      end else if FLocalName = 'position' then begin
        FXPathFunction := XPathFunctionPosition;
      end else if FLocalName = 'count' then begin
        FXPathFunction := XPathFunctionCount;
      end else if FLocalName = 'id' then begin
        FXPathFunction := XPathFunctionId;
      end else if FLocalName = 'local-name' then begin
        FXPathFunction := XPathFunctionLocalName;
      end else if FLocalName = 'namespace-uri' then begin
        FXPathFunction := XPathFunctionNamespaceUri;
      end else if FLocalName = 'name' then begin
        FXPathFunction := XPathFunctionName;
      end else if FLocalName = 'string' then begin
        FXPathFunction := XPathFunctionString;
      end else if FLocalName = 'concat' then begin
        FXPathFunction := XPathFunctionConcat;
      end else if FLocalName = 'starts-with' then begin
        FXPathFunction := XPathFunctionStartsWith;
      end else if FLocalName = 'contains' then begin
        FXPathFunction := XPathFunctionContains;
      end else if FLocalName = 'substring-before' then begin
        FXPathFunction := XPathFunctionSubstringBefore;
      end else if FLocalName = 'substring-after' then begin
        FXPathFunction := XPathFunctionSubstringAfter;
      end else if FLocalName = 'substring' then begin
        FXPathFunction := XPathFunctionSubstring;
      end else if FLocalName = 'string-length' then begin
        FXPathFunction := XPathFunctionStringLength;
      end else if FLocalName = 'normalize-space' then begin
        FXPathFunction := XPathFunctionNormalizeSpace;
      end else if FLocalName = 'translate' then begin
        FXPathFunction := XPathFunctionTranslate;
      end else if FLocalName = 'boolean' then begin
        FXPathFunction := XPathFunctionBoolean;
      end else if FLocalName = 'not' then begin
        FXPathFunction := XPathFunctionNot;
      end else if FLocalName = 'true' then begin
        FXPathFunction := XPathFunctionTrue;
      end else if FLocalName = 'false' then begin
        FXPathFunction := XPathFunctionFalse;
      end else if FLocalName = 'lang' then begin
        FXPathFunction := XPathFunctionLang;
      end else if FLocalName = 'number' then begin
        FXPathFunction := XPathFunctionNumber;
      end else if FLocalName = 'sum' then begin
        FXPathFunction := XPathFunctionSum;
      end else if FLocalName = 'floor' then begin
        FXPathFunction := XPathFunctionFloor;
      end else if FLocalName = 'ceiling' then begin
        FXPathFunction := XPathFunctionCeiling;
      end else if FLocalName = 'round' then begin
        FXPathFunction := XPathFunctionRound;
      end else FXPathFunction := nil;
    end else FXPathFunction := nil;
  end;
end;

{ TDomXPathUnionExpr }

function TDomXPathUnionExpr.Evaluate(const ContextNode: TDomNode;
                                     const ContextPosition,
                                           ContextSize: Integer): TDomXPathCustomResult;
var
  LeftSnapshotResult: TDomXPathNodeSetResult;
begin
  if (Left is TDomXPathUnionExpr) and (Right is TDomXPathPathExpr) then begin

    LeftSnapshotResult := TDomXPathNodeSetResult(TDomXPathUnionExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    LeftSnapshotResult.AxisType := XPATH_FORWARD_AXIS;
    try
      Result := TDomXPathPathExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize);
      TDomXPathNodeSetResult(Result).Merge(LeftSnapshotResult);
    finally
      LeftSnapshotResult.Free;
    end;

  end else if (Left is TDomXPathPathExpr) and not Assigned(Right) then begin

    Result := TDomXPathPathExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    if Result is TDomXPathNodeSetResult
      then Result.AxisType := XPATH_FORWARD_AXIS;

  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathPathExpr }

function TDomXPathPathExpr.AddStep(const Step: TDomXPathStep): Boolean;
begin
  if not Assigned(Right) then begin
    Right := Step;
    Result := True;
  end else begin
    if Right is TDomXPathStep
      then Result := TDomXPathStep(Right).AddStep(Step)
      else Result := False;
  end;
end;

function TDomXPathPathExpr.Evaluate(const ContextNode: TDomNode;
                                    const ContextPosition,
                                          ContextSize: Integer): TDomXPathCustomResult;
var
  NewResult: TDomXPathCustomResult;
begin
  if Left is TDomXPathFilterExpr then begin
    // Filter expression plus optional relative location path:
    NewResult := TDomXPathFilterExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    if Right is TDomXPathStep then begin
      if not (NewResult is TDomXPathNodeSetResult) then begin
        NewResult.Free;
        raise EXPath_Type_Err.Create('XPath type error.');
      end;
      Result := TDomXPathStep(Right).Evaluate(TDomXPathNodeSetResult(NewResult));
    end else Result := NewResult;
  end else if Left is TDomXPathAbsoluteLocationPath then begin
    // Absolute location path:
    if not Assigned(ContextNode) then
      raise EXPath_Type_Err.Create('XPath type error.');
    if not Assigned(ContextNode.RootDocument) then
      raise EXPath_Type_Err.Create('XPath type error.');
    NewResult := TDomXPathNodeSetResult.Create;
    TDomXPathNodeSetResult(NewResult).Add(ContextNode.RootDocument);
    if Right is TDomXPathStep
      then Result := TDomXPathStep(Right).Evaluate(TDomXPathNodeSetResult(NewResult))
      else Result := NewResult;
  end else begin
    // Relative location path:
    if not (Right is TDomXPathStep) then
      raise EXPath_Type_Err.Create('XPath type error.');
    if not Assigned(ContextNode) then
      raise EXPath_Type_Err.Create('XPath type error.');
    NewResult := TDomXPathNodeSetResult.Create;
    TDomXPathNodeSetResult(NewResult).Add(ContextNode);
    Result := TDomXPathStep(Right).Evaluate(TDomXPathNodeSetResult(NewResult))
  end;
end;

{ TDomXPathFilterExpr }

function TDomXPathFilterExpr.Evaluate(const ContextNode: TDomNode;
                                      const ContextPosition,
                                            ContextSize: Integer): TDomXPathCustomResult;
var
  NewResult: TDomXPathCustomResult;
begin
  if (Left is TDomXPathFilterExpr) and (Right is TDomXPathPredicate)
  then begin
    // Filter expression plus predicate:
    NewResult := TDomXPathFilterExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    if not (NewResult is TDomXPathNodeSetResult) then begin
      NewResult.Free;
      raise EXPath_Type_Err.Create('XPath type error.');
    end;

    // A predicate filters the node-set with respect to the child axis,
    // so the axis always has to be a forward axis, no matter what axis
    // the previous expression required:
    if NewResult is TDomXPathNodeSetResult
      then NewResult.AxisType := XPATH_FORWARD_AXIS;

    Result := TDomXPathPredicate(Right).Evaluate(TDomXPathNodeSetResult(NewResult));
  end else if (Left is TDomXPathPrimaryExpr) and not Assigned(Right) then begin
    // PrimaryExpr:
    Result := TDomXPathPrimaryExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathOrExpr }

function TDomXPathOrExpr.Evaluate(const ContextNode: TDomNode;
                                  const ContextPosition,
                                        ContextSize: Integer): TDomXPathCustomResult;
var
  BooleanResult: TDomXPathBooleanResult;
begin
  if (Left is TDomXPathOrExpr) and (Right is TDomXPathAndExpr) then begin
    BooleanResult := XPathBooleanFunc(TDomXPathOrExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    if BooleanResult.AsBoolean then begin
      Result := BooleanResult;
    end else begin
      BooleanResult.Free;
      Result := XPathBooleanFunc(TDomXPathAndExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
    end;
  end else if (Left is TDomXPathAndExpr) then begin
    Result := TDomXPathAndExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathAndExpr }

function TDomXPathAndExpr.Evaluate(const ContextNode: TDomNode;
                                   const ContextPosition,
                                         ContextSize: Integer): TDomXPathCustomResult;
var
  BooleanResult: TDomXPathBooleanResult;
begin
  if (Left is TDomXPathAndExpr) and (Right is TDomXPathEqualityExpr) then begin
    BooleanResult := XPathBooleanFunc(TDomXPathAndExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    if not BooleanResult.AsBoolean then begin
      Result := BooleanResult;
    end else begin
      BooleanResult.Free;
      Result := XPathBooleanFunc(TDomXPathEqualityExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
    end;
  end else if Left is TDomXPathEqualityExpr then begin
    Result := TDomXPathEqualityExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathIsEqualExpr }

function TDomXPathIsEqualExpr.Evaluate(const ContextNode: TDomNode;
                                       const ContextPosition,
                                             ContextSize: Integer): TDomXPathCustomResult;
var
  LeftResult, RightResult, SwapResult: TDomXPathCustomResult;
  StringResult: TDomXPathStringResult;
  LeftBoolean, RightBoolean: TDomXPathBooleanResult;
  LeftNumber, RightNumber: TDomXPathNumberResult;
  LeftString, RightString: TDomXPathStringResult;
  LeftResultString: WideString;
  I, J: Integer;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  Result := nil;
  if (Left is TDomXPathEqualityExpr) and (Right is TDomXPathRelationalExpr) then begin
    RightResult := nil; // Saves one try ... finally block.
    LeftResult := TDomXPathEqualityExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      RightResult := TDomXPathRelationalExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize);

      // Make sure, that if at least one set takes part in the comparision,
      // it is Assigned to RightResult:
      if RightResult is TDomXPathNodeSetResult then begin
        SwapResult := LeftResult;
        LeftResult := RightResult;
        RightResult := SwapResult;
      end;

      if LeftResult is TDomXPathNodeSetResult then begin
        if RightResult is TDomXPathNodeSetResult then begin
          for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
            LeftResultString:= TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue;
            for J := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
              if TDomXPathNodeSetResult(RightResult).Item(J).XPathStringValue = LeftResultString then begin
                Result := TDomXPathBooleanResult.Create(True);
                Exit;
              end;
            end;
          end;
          Result := TDomXPathBooleanResult.Create(False);
          Exit;
        end else if (RightResult is TDomXPathNumberResult) or
                    (RightResult is TDomXPathBooleanResult) or
                    (RightResult is TDomXPathStringResult)
        then begin
          StringResult := XPathStringFunc(RightResult);
          for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
            if TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue = StringResult.AsWideString then begin
              Result := TDomXPathBooleanResult.Create(True);
              RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
              Exit;
            end;
          end;
          Result := TDomXPathBooleanResult.Create(False);
          RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
          Exit;
        end;
      end else if (LeftResult is TDomXPathBooleanResult) or
                  (RightResult is TDomXPathBooleanResult)
      then begin
        LeftBoolean:= XPathBooleanFunc(LeftResult);
        RightBoolean:= XPathBooleanFunc(RightResult);
        if LeftBoolean.AsBoolean = RightBoolean.AsBoolean
          then Result := TDomXPathBooleanResult.Create(True)
          else Result := TDomXPathBooleanResult.Create(False);
        LeftResult := LeftBoolean;    // Re-assignment is required for correct
        RightResult := RightBoolean;  // freeing the TDomXPathCustomResult below.
      end else if (LeftResult is TDomXPathNumberResult) or
                  (RightResult is TDomXPathNumberResult)
      then begin
        LeftNumber := XPathNumberFunc(LeftResult);
        RightNumber := XPathNumberFunc(RightResult);
{$IFDEF VER140+}
        ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
        try
          if LeftNumber.AsNumber = RightNumber.AsNumber
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$IFDEF VER140+}
        finally
          SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
        except
          if (IsNaN(LeftNumber.AsNumber) and  IsNaN(RightNumber.AsNumber)) or
             (Sign(LeftNumber.AsNumber) = Sign(RightNumber.AsNumber))
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$ENDIF}
        end;
        LeftResult := LeftNumber;    // Re-assignment is required for correct
        RightResult := RightNumber;  // freeing the TDomXPathCustomResult below.
      end else begin
        LeftString:= XPathStringFunc(LeftResult);
        RightString:= XPathStringFunc(RightResult);
        if LeftString.AsWideString = RightString.AsWideString
          then Result := TDomXPathBooleanResult.Create(True)
          else Result := TDomXPathBooleanResult.Create(False);
        LeftResult := LeftString;    // Re-assignment is required for correct
        RightResult := RightString;  // freeing the TDomXPathCustomResult below.
      end;

    finally
      RightResult.Free;
      LeftResult.Free;
    end;
  end else if Left is TDomXPathRelationalExpr then begin
    Result := TDomXPathRelationalExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathIsNotEqualExpr }

function TDomXPathIsNotEqualExpr.Evaluate(const ContextNode: TDomNode;
                                          const ContextPosition,
                                                ContextSize: Integer): TDomXPathCustomResult;
var
  LeftResult, RightResult, SwapResult: TDomXPathCustomResult;
  StringResult: TDomXPathStringResult;
  LeftBoolean, RightBoolean: TDomXPathBooleanResult;
  LeftNumber, RightNumber: TDomXPathNumberResult;
  LeftString, RightString: TDomXPathStringResult;
  LeftResultString: WideString;
  I, J: Integer;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  Result := nil;
  if (Left is TDomXPathEqualityExpr) and (Right is TDomXPathRelationalExpr) then begin
    RightResult := nil; // Saves one try ... finally block.
    LeftResult := TDomXPathEqualityExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      RightResult := TDomXPathRelationalExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize);

      // Make sure, that if at least one set takes part in the comparision,
      // it is Assigned to RightResult:
      if RightResult is TDomXPathNodeSetResult then begin
        SwapResult := LeftResult;
        LeftResult := RightResult;
        RightResult := SwapResult;
      end;

      if LeftResult is TDomXPathNodeSetResult then begin
        if RightResult is TDomXPathNodeSetResult then begin
          for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
            LeftResultString:= TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue;
            for J := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
              if TDomXPathNodeSetResult(RightResult).Item(J).XPathStringValue <> LeftResultString then begin
                Result := TDomXPathBooleanResult.Create(True);
                Exit;
              end;
            end;
          end;
          Result := TDomXPathBooleanResult.Create(False);
          Exit;
        end else if (RightResult is TDomXPathNumberResult) or
                    (RightResult is TDomXPathBooleanResult) or
                    (RightResult is TDomXPathStringResult)
        then begin
          StringResult := XPathStringFunc(RightResult);
          for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
            if TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue <> StringResult.AsWideString then begin
              Result := TDomXPathBooleanResult.Create(True);
              RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
              Exit;
            end;
          end;
          Result := TDomXPathBooleanResult.Create(False);
          RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
          Exit;
        end;
      end else if (LeftResult is TDomXPathBooleanResult) or
                  (RightResult is TDomXPathBooleanResult)
      then begin
        LeftBoolean:= XPathBooleanFunc(LeftResult);
        RightBoolean:= XPathBooleanFunc(RightResult);
        if LeftBoolean.AsBoolean <> RightBoolean.AsBoolean
          then Result := TDomXPathBooleanResult.Create(True)
          else Result := TDomXPathBooleanResult.Create(False);
        LeftResult := LeftBoolean;    // Re-assignment is required for correct
        RightResult := RightBoolean;  // freeing the TDomXPathCustomResult below.
      end else if (LeftResult is TDomXPathNumberResult) or
                  (RightResult is TDomXPathNumberResult)
      then begin
        LeftNumber := XPathNumberFunc(LeftResult);
        RightNumber := XPathNumberFunc(RightResult);
{$IFDEF VER140+}
        ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
        try
          if LeftNumber.AsNumber <> RightNumber.AsNumber
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$IFDEF VER140+}
        finally
          SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
        except
          if (IsNaN(LeftNumber.AsNumber) and not IsNaN(RightNumber.AsNumber)) or
             (IsNaN(RightNumber.AsNumber) and not IsNaN(LeftNumber.AsNumber)) or
             (Sign(LeftNumber.AsNumber) <> Sign(RightNumber.AsNumber))
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$ENDIF}
        end;
        LeftResult := LeftNumber;    // Re-assignment is required for correct
        RightResult := RightNumber;  // freeing the TDomXPathCustomResult below.
      end else begin
        LeftString:= XPathStringFunc(LeftResult);
        RightString:= XPathStringFunc(RightResult);
        if LeftString.AsWideString <> RightString.AsWideString
          then Result := TDomXPathBooleanResult.Create(True)
          else Result := TDomXPathBooleanResult.Create(False);
        LeftResult := LeftString;    // Re-assignment is required for correct
        RightResult := RightString;  // freeing the TDomXPathCustomResult below.
      end;

    finally
      RightResult.Free;
      LeftResult.Free;
    end;
  end else if Left is TDomXPathRelationalExpr then begin
    Result := TDomXPathRelationalExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathLessThanExpr }

function TDomXPathLessThanExpr.Evaluate(const ContextNode: TDomNode;
                                        const ContextPosition,
                                              ContextSize: Integer): TDomXPathCustomResult;
var
  LeftResult, RightResult: TDomXPathCustomResult;
  StringResult: TDomXPathStringResult;
  LeftNumber, RightNumber: TDomXPathNumberResult;
  LeftResultString: WideString;
  I, J: Integer;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathRelationalExpr) and (Right is TDomXPathAdditiveExpr) then begin
    RightResult := nil; // Saves one try ... finally block.
    LeftResult := TDomXPathRelationalExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      RightResult := TDomXPathAdditiveExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize);

      if (LeftResult is TDomXPathNodeSetResult) and
         (RightResult is TDomXPathNodeSetResult)
      then begin
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          LeftResultString:= TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue;
          for J := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
            if TDomXPathNodeSetResult(RightResult).Item(J).XPathStringValue < LeftResultString then begin
              Result := TDomXPathBooleanResult.Create(True);
              Exit;
            end;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        Exit;
      end else if (LeftResult is TDomXPathNodeSetResult) and
                  ( (RightResult is TDomXPathNumberResult) or
                    (RightResult is TDomXPathBooleanResult) or
                    (RightResult is TDomXPathStringResult) )
      then begin
        StringResult := XPathStringFunc(RightResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          if TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue < StringResult.AsWideString then begin
            Result := TDomXPathBooleanResult.Create(True);
            RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else if ( (LeftResult is TDomXPathNumberResult) or
                    (LeftResult is TDomXPathBooleanResult) or
                    (LeftResult is TDomXPathStringResult) ) and
                  (RightResult is TDomXPathNodeSetResult)
      then begin
        StringResult := XPathStringFunc(LeftResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
          if StringResult.AsWideString < TDomXPathNodeSetResult(RightResult).Item(I).XPathStringValue then begin
            Result := TDomXPathBooleanResult.Create(True);
            LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else begin
        LeftNumber := XPathNumberFunc(LeftResult);
        RightNumber := XPathNumberFunc(RightResult);
{$IFDEF VER140+}
        ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
        try
          if LeftNumber.AsNumber < RightNumber.AsNumber
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$IFDEF VER140+}
        finally
          SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
        except
          Result := TDomXPathBooleanResult.Create(False);
{$ENDIF}
        end;
        LeftResult := LeftNumber;    // Re-assignment is required for correct
        RightResult := RightNumber;  // freeing the TDomXPathCustomResult below.
      end;

    finally
      RightResult.Free;
      LeftResult.Free;
    end;
  end else if Left is TDomXPathAdditiveExpr then begin
    Result := TDomXPathAdditiveExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathLessThanOrEqualExpr }

function TDomXPathLessThanOrEqualExpr.Evaluate(const ContextNode: TDomNode;
                                               const ContextPosition,
                                                     ContextSize: Integer): TDomXPathCustomResult;
var
  LeftResult, RightResult: TDomXPathCustomResult;
  StringResult: TDomXPathStringResult;
  LeftNumber, RightNumber: TDomXPathNumberResult;
  LeftResultString: WideString;
  I, J: Integer;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathRelationalExpr) and (Right is TDomXPathAdditiveExpr) then begin
    RightResult := nil; // Saves one try ... finally block.
    LeftResult := TDomXPathRelationalExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      RightResult := TDomXPathAdditiveExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize);

      if (LeftResult is TDomXPathNodeSetResult) and
         (RightResult is TDomXPathNodeSetResult)
      then begin
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          LeftResultString:= TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue;
          for J := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
            if TDomXPathNodeSetResult(RightResult).Item(J).XPathStringValue <= LeftResultString then begin
              Result := TDomXPathBooleanResult.Create(True);
              Exit;
            end;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        Exit;
      end else if (LeftResult is TDomXPathNodeSetResult) and
                  ( (RightResult is TDomXPathNumberResult) or
                    (RightResult is TDomXPathBooleanResult) or
                    (RightResult is TDomXPathStringResult) )
      then begin
        StringResult := XPathStringFunc(RightResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          if TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue <= StringResult.AsWideString then begin
            Result := TDomXPathBooleanResult.Create(True);
            RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else if ( (LeftResult is TDomXPathNumberResult) or
                    (LeftResult is TDomXPathBooleanResult) or
                    (LeftResult is TDomXPathStringResult) ) and
                  (RightResult is TDomXPathNodeSetResult)
      then begin
        StringResult := XPathStringFunc(LeftResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
          if StringResult.AsWideString <= TDomXPathNodeSetResult(RightResult).Item(I).XPathStringValue then begin
            Result := TDomXPathBooleanResult.Create(True);
            LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else begin
        LeftNumber := XPathNumberFunc(LeftResult);
        RightNumber := XPathNumberFunc(RightResult);
{$IFDEF VER140+}
        ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
        try
          if LeftNumber.AsNumber <= RightNumber.AsNumber
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$IFDEF VER140+}
        finally
          SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
        except
          if (IsNaN(LeftNumber.AsNumber) and not IsNaN(RightNumber.AsNumber)) or
             (IsNaN(RightNumber.AsNumber) and not IsNaN(LeftNumber.AsNumber)) or
             (Sign(LeftNumber.AsNumber) <> Sign(RightNumber.AsNumber))
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$ENDIF}
        end;
        LeftResult := LeftNumber;    // Re-assignment is required for correct
        RightResult := RightNumber;  // freeing the TDomXPathCustomResult below.
      end;

    finally
      RightResult.Free;
      LeftResult.Free;
    end;
  end else if Left is TDomXPathAdditiveExpr then begin
    Result := TDomXPathAdditiveExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathGreaterThanExpr }

function TDomXPathGreaterThanExpr.Evaluate(const ContextNode: TDomNode;
                                           const ContextPosition,
                                                 ContextSize: Integer): TDomXPathCustomResult;
var
  LeftResult, RightResult: TDomXPathCustomResult;
  StringResult: TDomXPathStringResult;
  LeftNumber,RightNumber: TDomXPathNumberResult;
  LeftResultString: WideString;
  I, J: Integer;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathRelationalExpr) and (Right is TDomXPathAdditiveExpr) then begin
    RightResult := nil; // Saves one try ... finally block.
    LeftResult := TDomXPathRelationalExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      RightResult := TDomXPathAdditiveExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize);

      if (LeftResult is TDomXPathNodeSetResult) and
         (RightResult is TDomXPathNodeSetResult)
      then begin
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          LeftResultString:= TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue;
          for J := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
            if TDomXPathNodeSetResult(RightResult).Item(J).XPathStringValue > LeftResultString then begin
              Result := TDomXPathBooleanResult.Create(True);
              Exit;
            end;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        Exit;
      end else if (LeftResult is TDomXPathNodeSetResult) and
                  ( (RightResult is TDomXPathNumberResult) or
                    (RightResult is TDomXPathBooleanResult) or
                    (RightResult is TDomXPathStringResult) )
      then begin
        StringResult := XPathStringFunc(RightResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          if TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue > StringResult.AsWideString then begin
            Result := TDomXPathBooleanResult.Create(True);
            RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else if ( (LeftResult is TDomXPathNumberResult) or
                    (LeftResult is TDomXPathBooleanResult) or
                    (LeftResult is TDomXPathStringResult) ) and
                  (RightResult is TDomXPathNodeSetResult)
      then begin
        StringResult := XPathStringFunc(LeftResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
          if StringResult.AsWideString > TDomXPathNodeSetResult(RightResult).Item(I).XPathStringValue then begin
            Result := TDomXPathBooleanResult.Create(True);
            LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else begin
        LeftNumber := XPathNumberFunc(LeftResult);
        RightNumber := XPathNumberFunc(RightResult);
{$IFDEF VER140+}
        ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
        try
          if LeftNumber.AsNumber > RightNumber.AsNumber
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$IFDEF VER140+}
        finally
          SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
        except
          Result := TDomXPathBooleanResult.Create(False);
{$ENDIF}
        end;
        LeftResult := LeftNumber;    // Re-assignment is required for correct
        RightResult := RightNumber;  // freeing the TDomXPathCustomResult below.
      end;

    finally
      RightResult.Free;
      LeftResult.Free;
    end;
  end else if Left is TDomXPathAdditiveExpr then begin
    Result := TDomXPathAdditiveExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathGreaterThanOrEqualExpr }

function TDomXPathGreaterThanOrEqualExpr.Evaluate(const ContextNode: TDomNode;
                                                  const ContextPosition,
                                                        ContextSize: Integer): TDomXPathCustomResult;
var
  LeftResult,RightResult: TDomXPathCustomResult;
  StringResult: TDomXPathStringResult;
  LeftNumber,RightNumber: TDomXPathNumberResult;
  LeftResultString: WideString;
  I,J: Integer;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathRelationalExpr) and (Right is TDomXPathAdditiveExpr) then begin
    RightResult := nil; // Saves one try ... finally block.
    LeftResult := TDomXPathRelationalExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
    try
      RightResult := TDomXPathAdditiveExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize);

      if (LeftResult is TDomXPathNodeSetResult) and
         (RightResult is TDomXPathNodeSetResult)
      then begin
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          LeftResultString:= TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue;
          for J := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
            if TDomXPathNodeSetResult(RightResult).Item(J).XPathStringValue >= LeftResultString then begin
              Result := TDomXPathBooleanResult.Create(True);
              Exit;
            end;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        Exit;
      end else if (LeftResult is TDomXPathNodeSetResult) and
                  ( (RightResult is TDomXPathNumberResult) or
                    (RightResult is TDomXPathBooleanResult) or
                    (RightResult is TDomXPathStringResult) )
      then begin
        StringResult := XPathStringFunc(RightResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(LeftResult).Length) do begin
          if TDomXPathNodeSetResult(LeftResult).Item(I).XPathStringValue >= StringResult.AsWideString then begin
            Result := TDomXPathBooleanResult.Create(True);
            RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        RightResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else if ( (LeftResult is TDomXPathNumberResult) or
                    (LeftResult is TDomXPathBooleanResult) or
                    (LeftResult is TDomXPathStringResult) ) and
                  (RightResult is TDomXPathNodeSetResult)
      then begin
        StringResult := XPathStringFunc(LeftResult);
        for I := 0 to Pred(TDomXPathNodeSetResult(RightResult).Length) do begin
          if StringResult.AsWideString >= TDomXPathNodeSetResult(RightResult).Item(I).XPathStringValue then begin
            Result := TDomXPathBooleanResult.Create(True);
            LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
            Exit;
          end;
        end;
        Result := TDomXPathBooleanResult.Create(False);
        LeftResult := StringResult;  // Re-assignment is required for correct freeing the TDomXPathCustomResult below.
        Exit;
      end else begin
        LeftNumber := XPathNumberFunc(LeftResult);
        RightNumber := XPathNumberFunc(RightResult);
{$IFDEF VER140+}
        ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
        try
          if LeftNumber.AsNumber >= RightNumber.AsNumber
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$IFDEF VER140+}
        finally
          SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
        except
          if (IsNaN(LeftNumber.AsNumber) and not IsNaN(RightNumber.AsNumber)) or
             (IsNaN(RightNumber.AsNumber) and not IsNaN(LeftNumber.AsNumber)) or
             (Sign(LeftNumber.AsNumber) <> Sign(RightNumber.AsNumber))
            then Result := TDomXPathBooleanResult.Create(True)
            else Result := TDomXPathBooleanResult.Create(False);
{$ENDIF}
        end;
        LeftResult := LeftNumber;    // Re-assignment is required for correct
        RightResult := RightNumber;  // freeing the TDomXPathCustomResult below.
      end;

    finally
      RightResult.Free;
      LeftResult.Free;
    end;
  end else if Left is TDomXPathAdditiveExpr then begin
    Result := TDomXPathAdditiveExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathPlusExpr }

function TDomXPathPlusExpr.Evaluate(const ContextNode: TDomNode;
                                    const ContextPosition,
                                          ContextSize: Integer): TDomXPathCustomResult;
var
  LeftNumber,RightNumber: TDomXPathNumberResult;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathAdditiveExpr) and (Right is TDomXPathMultiplicativeExpr) then begin
    RightNumber := nil; // Saves one try ... finally block.
    LeftNumber := XPathNumberFunc(TDomXPathAdditiveExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    try
      RightNumber := XPathNumberFunc(TDomXPathMultiplicativeExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
{$IFDEF VER140+}
      ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
      try
        Result := TDomXPathNumberResult.Create(LeftNumber.AsNumber + RightNumber.AsNumber);
{$IFDEF VER140+}
      finally
        SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
      except
        Result := TDomXPathNumberResult.Create(NaN);
{$ENDIF}
      end;
    finally
      RightNumber.Free;
      LeftNumber.Free;
    end;
  end else if Left is TDomXPathMultiplicativeExpr then begin
    Result := TDomXPathMultiplicativeExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathMinusExpr }

function TDomXPathMinusExpr.Evaluate(const ContextNode: TDomNode;
                                     const ContextPosition,
                                           ContextSize: Integer): TDomXPathCustomResult;
var
  LeftNumber,RightNumber: TDomXPathNumberResult;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathAdditiveExpr) and (Right is TDomXPathMultiplicativeExpr) then begin
    RightNumber := nil; // Saves one try ... finally block.
    LeftNumber := XPathNumberFunc(TDomXPathAdditiveExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    try
      RightNumber := XPathNumberFunc(TDomXPathMultiplicativeExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
{$IFDEF VER140+}
      ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
      try
        Result := TDomXPathNumberResult.Create(LeftNumber.AsNumber - RightNumber.AsNumber);
{$IFDEF VER140+}
      finally
        SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
      except
        Result := TDomXPathNumberResult.Create(NaN);
{$ENDIF}
      end;
    finally
      RightNumber.Free;
      LeftNumber.Free;
    end;
  end else if Left is TDomXPathMultiplicativeExpr then begin
    Result := TDomXPathMultiplicativeExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathMultiplyExpr }

function TDomXPathMultiplyExpr.Evaluate(const ContextNode: TDomNode;
                                        const ContextPosition,
                                              ContextSize: Integer): TDomXPathCustomResult;
var
  LeftNumber,RightNumber: TDomXPathNumberResult;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathMultiplicativeExpr) and (Right is TDomXPathUnaryExpr) then begin
    RightNumber := nil; // Saves one try ... finally block.
    LeftNumber := XPathNumberFunc(TDomXPathMultiplicativeExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    try
      RightNumber := XPathNumberFunc(TDomXPathUnaryExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
{$IFDEF VER140+}
      ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
      try
        Result := TDomXPathNumberResult.Create(LeftNumber.AsNumber * RightNumber.AsNumber);
{$IFDEF VER140+}
      finally
        SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
      except
        Result := TDomXPathNumberResult.Create(NaN);
{$ENDIF}
      end;
    finally
      RightNumber.Free;
      LeftNumber.Free;
    end;
  end else if Left is TDomXPathUnaryExpr then begin
    Result := TDomXPathUnaryExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathDivExpr }

function TDomXPathDivExpr.Evaluate(const ContextNode: TDomNode;
                                   const ContextPosition,
                                         ContextSize: Integer): TDomXPathCustomResult;
var
  LeftNumber,RightNumber: TDomXPathNumberResult;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathMultiplicativeExpr) and (Right is TDomXPathUnaryExpr) then begin
    RightNumber := nil; // Saves one try ... finally block.
    LeftNumber := XPathNumberFunc(TDomXPathMultiplicativeExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    try
      RightNumber := XPathNumberFunc(TDomXPathUnaryExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
{$IFDEF VER140+}
      ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
      try
        Result := TDomXPathNumberResult.Create(LeftNumber.AsNumber / RightNumber.AsNumber);
{$IFDEF VER140+}
      finally
        SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
      except
        Result := TDomXPathNumberResult.Create(NaN);
{$ENDIF}
      end;
    finally
      RightNumber.Free;
      LeftNumber.Free;
    end;
  end else if Left is TDomXPathUnaryExpr then begin
    Result := TDomXPathUnaryExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathModExpr }

function TDomXPathModExpr.Evaluate(const ContextNode: TDomNode;
                                   const ContextPosition,
                                         ContextSize: Integer): TDomXPathCustomResult;
var
  LeftNumber,RightNumber: TDomXPathNumberResult;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathMultiplicativeExpr) and (Right is TDomXPathUnaryExpr) then begin
    RightNumber := nil; // Saves one try ... finally block.
    LeftNumber := XPathNumberFunc(TDomXPathMultiplicativeExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize));
    try
      RightNumber := XPathNumberFunc(TDomXPathUnaryExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
{$IFDEF VER140+}
      ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
      try
        Result := TDomXPathNumberResult.Create(LeftNumber.AsNumber - Trunc(LeftNumber.AsNumber / RightNumber.AsNumber) * RightNumber.AsNumber);
{$IFDEF VER140+}
      finally
        SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
      except
        Result := TDomXPathNumberResult.Create(NaN);
{$ENDIF}
      end;
    finally
      RightNumber.Free;
      LeftNumber.Free;
    end;
  end else if Left is TDomXPathUnaryExpr then begin
    Result := TDomXPathUnaryExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathUnaryExpr }

function TDomXPathUnaryExpr.Evaluate(const ContextNode: TDomNode;
                                     const ContextPosition,
                                           ContextSize: Integer): TDomXPathCustomResult;
var
  Number: TDomXPathNumberResult;
{$IFDEF VER140+}
  ExceptionMaskBackup: TFPUExceptionMask;
{$ENDIF}
begin
  if (Left is TDomXPathMinusOperator) and (Right is TDomXPathUnaryExpr) then begin
    Number := XPathNumberFunc(TDomXPathUnaryExpr(Right).Evaluate(ContextNode, ContextPosition, ContextSize));
    try
{$IFDEF VER140+}
      ExceptionMaskBackup:= SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
{$ENDIF}
      try
        Result := TDomXPathNumberResult.Create(-(Number.AsNumber));
{$IFDEF VER140+}
      finally
        SetExceptionMask(ExceptionMaskBackup);
{$ELSE}
      except
        Result := TDomXPathNumberResult.Create(NaN);
{$ENDIF}
      end;
    finally
      Number.Free;
    end;
  end else if Left is TDomXPathUnionExpr then begin
    Result := TDomXPathUnionExpr(Left).Evaluate(ContextNode, ContextPosition, ContextSize);
  end else raise EXPath_Type_Err.Create('XPath type error.');
end;

{ TDomXPathLiteral }

function TDomXPathLiteral.Evaluate: TDomXPathCustomResult;
begin
  Result := TDomXPathStringResult.Create(Value);
end;

{ TDomXPathNumber }

function TDomXPathNumber.Evaluate: TDomXPathCustomResult;
begin
  Result := TDomXPathNumberResult.Create(XPathWideStringToNumber(Value));
end;

{ TDomXPathVariableReference }

constructor TDomXPathVariableReference.Create(const AOwner: TDomXPathSyntaxTree;
                                              const Value: WideString);
begin
  inherited;
  FPrefix := XmlExtractPrefix(Value);
  FLocalName := XmlExtractLocalName(Value);
end;

function TDomXPathVariableReference.Evaluate: TDomXPathCustomResult;
var
  NsUri: WideString;
begin
  Result := nil;

  // Determine Namespace URI
  NsUri := LookupNamespaceURI(FPrefix);
  if (NsUri = '') and (FPrefix <> '') then
    raise ENamespace_Err.CreateFmt('Namespace URI of prefix ''%S'' not found.',
                                   [FPrefix]);

  if Assigned(OwnerSyntaxTree) then with OwnerSyntaxTree do
    if Assigned(ContextNode) then with ContextNode do
      if Assigned(OwnerDocument) then with OwnerDocument do
        if Assigned(DomImplementation) then
          DomImplementation.DoRequestXPathVariable(OwnerXPathExpression, NsUri, FLocalName, Result);

  if not Assigned(Result) then
    raise EXPath_Exception.CreateFmt('No binding for variable $%s provided.',[Value]);
end;

{ TDomXPathNameTest }

constructor TDomXPathNameTest.Create(const AOwner: TDomXPathSyntaxTree;
                                     const Value: WideString);
begin
  inherited;
  if Value = '*' then begin
    FPrefix := '';
    FLocalName := '*';
  end else if Value[Length(Value)] = '*' then begin
    FPrefix := Copy(Value, 1,Length(Value)-2);
    FLocalName := '*';
  end else begin
    FPrefix := XmlExtractPrefix(Value);
    FLocalName := XmlExtractLocalName(Value);
  end;
end;

function TDomXPathNameTest.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult;
                                    const PrincipalNodeType: TDomNodeType): TDomXPathNodeSetResult;
var
  NsUri: WideString;
  I: Integer;
begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');

  if Value = '*' then begin

    with OldSnapshotResult do begin
      I := Pred(Length);
      while I >= 0 do begin
        if Item(I).NodeType <> principalNodeType then
          Delete(I);
        Dec(I);
      end;
    end;

  end else begin

    // Determine Namespace URI
    if FPrefix = '' then
      NsUri := ''
    else begin
      NsUri := LookupNamespaceURI(FPrefix);
      if NsUri = '' then begin
        OldSnapshotResult.Free;
        raise ENamespace_Err.CreateFmt('Namespace URI of prefix ''%S'' not found.',
                                       [FPrefix]);
      end;
    end;
    
    if FLocalName = '*' then begin

      with OldSnapshotResult do begin
        I := Pred(Length);
        while I >= 0 do begin
          with Item(I) do
            if (NodeType <> principalNodeType) or
               (NamespaceURI <> NsUri) then
              Delete(I);
          Dec(I);
        end;
      end;

    end else begin

      with OldSnapshotResult do begin
        I := Pred(Length);
        while I >= 0 do begin
          with Item(I) do
            if (NodeType <> principalNodeType) or
               (NamespaceURI <> NsUri) or
               (LocalName <> FLocalName) then
              Delete(I);
          Dec(I);
        end;
      end;

    end;

  end;

  Result := OldSnapshotResult;
end;

{ TDomXPathNodeTypeComment }

function TDomXPathNodeTypeComment.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
var
  I: Integer;
begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');

  with OldSnapshotResult do begin
    I := Pred(Length);
    while I >= 0 do begin
      if Item(I).NodeType <> ntComment_Node
        then Delete(I);
      Dec(I);
    end;
  end;

  Result := OldSnapshotResult;
end;

{ TDomXPathNodeTypePI }

function TDomXPathNodeTypePI.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
var
  I: Integer;
begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');

  if Assigned(Left) then begin
    if Left is TDomXPathLiteral then begin
      with OldSnapshotResult do begin
        I := Pred(Length);
        while I >= 0 do begin
          with Item(I) do
            if (NodeType <> ntProcessing_Instruction_Node) or
               (nodeValue <> TDomXPathLiteral(Left).Value)
              then Delete(I);
          Dec(I);
        end;
      end;
    end else begin
      OldSnapshotResult.Free;
      raise EXPath_Type_Err.Create('XPath type error.');
    end;
  end else begin
    with OldSnapshotResult do begin
      I := Pred(Length);
      while I >= 0 do begin
        if Item(I).NodeType <> ntProcessing_Instruction_Node
          then Delete(I);
        Dec(I);
      end;
    end;
  end;

  Result := OldSnapshotResult;
end;

{ TDomXPathNodeTypeText }

function TDomXPathNodeTypeText.Evaluate(const OldSnapshotResult: TDomXPathNodeSetResult): TDomXPathNodeSetResult;
var
  I: Integer;
begin
  if not Assigned(OldSnapshotResult) then
    raise EXPath_Type_Err.Create('XPath type error.');

  with OldSnapshotResult do begin
    I := Pred(Length);
    while I >= 0 do begin
      if not (Item(I).NodeType in [ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node] )
        then Delete(I);
      Dec(I);
    end;
  end;

  Result := OldSnapshotResult;
end;

{$WARNINGS ON}
{$HINTS ON}
{$NOTES ON}

end.
